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
 176     return $res;
 177 }
 178
 179 __PACKAGE__->register_method(
 180     method    => "template_overlay_biblio_record_entry",
 181     api_name  => "open-ils.cat.biblio.record_entry.template_overlay",
 182     stream    => 1,
 183     signature => q#
 184         Overlays biblio.record_entry MARC values
 185         @param auth The authtoken
 186         @param records The record ids to be updated by the template
 187         @param template The overlay template
 188         @return Stream of hashes record id in the key "record" and t or f for the success of the overlay operation in key "success"
 189     #
 190 );
 191
 192 sub template_overlay_biblio_record_entry {
 193     my($self, $conn, $auth, $records, $template) = @_;
 194     my $e = new_editor(authtoken=>$auth, xact=>1);
 195     return $e->die_event unless $e->checkauth;
 196
 197     $records = [$records] if (!ref($records));
 198
 199     for my $rid ( @$records ) {
 200         my $rec = $e->retrieve_biblio_record_entry($rid);
 201         next unless $rec;
 202
 203         unless ($e->allowed('UPDATE_RECORD', $rec->owner, $rec)) {
 204             $conn->respond({ record => $rid, success => 'f' });
 205             next;
 206         }
 207
 208         my $success = $e->json_query(
 209             { from => [ 'vandelay.template_overlay_bib_record', $template, $rid ] }
 210         )->[0]->{'vandelay.template_overlay_bib_record'};
 211
 212         $conn->respond({ record => $rid, success => $success });
 213     }
 214
 215     $e->commit;
 216     return undef;
 217 }
 218
 219 __PACKAGE__->register_method(
 220     method    => "template_overlay_container",
 221     api_name  => "open-ils.cat.container.template_overlay",
 222     stream    => 1,
 223     signature => q#
 224         Overlays biblio.record_entry MARC values
 225         @param auth The authtoken
 226         @param container The container, um, containing the records to be updated by the template
 227         @param template The overlay template, or nothing and the method will look for a negative bib id in the container
 228         @return Stream of hashes record id in the key "record" and t or f for the success of the overlay operation in key "success"
 229     #
 230 );
 231
 232 __PACKAGE__->register_method(
 233     method    => "template_overlay_container",
 234     api_name  => "open-ils.cat.container.template_overlay.background",
 235     stream    => 1,
 236     signature => q#
 237         Overlays biblio.record_entry MARC values
 238         @param auth The authtoken
 239         @param container The container, um, containing the records to be updated by the template
 240         @param template The overlay template, or nothing and the method will look for a negative bib id in the container
 241         @return Cache key to check for status of the container overlay
 242     #
 243 );
 244
 245 sub template_overlay_container {
 246     my($self, $conn, $auth, $container, $template) = @_;
 247     my $e = new_editor(authtoken=>$auth, xact=>1);
 248     return $e->die_event unless $e->checkauth;
 249
 250     my $actor = OpenSRF::AppSession->create('open-ils.actor') if ($self->api_name =~ /background$/);
 251
 252     my $items = $e->search_container_biblio_record_entry_bucket_item({ bucket => $container });
 253
 254     my $titem;
 255     if (!$template) {
 256         ($titem) = grep { $_->target_biblio_record_entry < 0 } @$items;
 257         if (!$titem) {
 258             $e->rollback;
 259             return undef;
 260         }
 261         $items = [grep { $_->target_biblio_record_entry > 0 } @$items];
 262
 263         $template = $e->retrieve_biblio_record_entry( $titem->target_biblio_record_entry )->marc;
 264     }
 265
 266     my $responses = [];
 267     my $some_failed = 0;
 268
 269     $conn->respond_complete(
 270         $actor->request('open-ils.actor.anon_cache.set_value', $auth, res_list => $responses)->gather(1)
 271     ) if ($actor);
 272
 273     for my $item ( @$items ) {
 274         my $rec = $e->retrieve_biblio_record_entry($item->target_biblio_record_entry);
 275         next unless $rec;
 276
 277         my $success = 'f';
 278         if ($e->allowed('UPDATE_RECORD', $rec->owner, $rec)) {
 279             $success = $e->json_query(
 280                 { from => [ 'vandelay.template_overlay_bib_record', $template, $rec->id ] }
 281             )->[0]->{'vandelay.template_overlay_bib_record'};
 282         }
 283
 284         $some_failed++ if ($success eq 'f');
 285
 286         if ($actor) {
 287             push @$responses, { record => $rec->id, success => $success };
 288             $actor->request('open-ils.actor.anon_cache.set_value', $auth, res_list => $responses);
 289         } else {
 290             $conn->respond({ record => $rec->id, success => $success });
 291         }
 292
 293         if ($success eq 't') {
 294             unless ($e->delete_container_biblio_record_entry_bucket_item($item)) {
 295                 $e->rollback;
 296                 if ($actor) {
 297                     push @$responses, { complete => 1, success => 'f' };
 298                     $actor->request('open-ils.actor.anon_cache.set_value', $auth, res_list => $responses);
 299                     return undef;
 300                 } else {
 301                     return { complete => 1, success => 'f' };
 302                 }
 303             }
 304         }
 305     }
 306
 307     if ($titem && !$some_failed) {
 308         return $e->die_event unless ($e->delete_container_biblio_record_entry_bucket_item($titem));
 309     }
 310
 311     if ($e->commit) {
 312         if ($actor) {
 313             push @$responses, { complete => 1, success => 't' };
 314             $actor->request('open-ils.actor.anon_cache.set_value', $auth, res_list => $responses);
 315         } else {
 316             return { complete => 1, success => 't' };
 317         }
 318     } else {
 319         if ($actor) {
 320             push @$responses, { complete => 1, success => 'f' };
 321             $actor->request('open-ils.actor.anon_cache.set_value', $auth, res_list => $responses);
 322         } else {
 323             return { complete => 1, success => 'f' };
 324         }
 325     }
 326     return undef;
 327 }
 328
 329 __PACKAGE__->register_method(
 330     method    => "update_biblio_record_entry",
 331     api_name  => "open-ils.cat.biblio.record_entry.update",
 332     signature => q/
 333         Updates a biblio.record_entry
 334         @param auth The authtoken
 335         @param record The record with updated values
 336         @return 1 on success, Event on error.
 337     /
 338 );
 339
 340 sub update_biblio_record_entry {
 341     my($self, $conn, $auth, $record) = @_;
 342     my $e = new_editor(authtoken=>$auth, xact=>1);
 343     return $e->die_event unless $e->checkauth;
 344     return $e->die_event unless $e->allowed('UPDATE_RECORD');
 345     $e->update_biblio_record_entry($record) or return $e->die_event;
 346     $e->commit;
 347     return 1;
 348 }
 349
 350 __PACKAGE__->register_method(
 351     method    => "undelete_biblio_record_entry",
 352     api_name  => "open-ils.cat.biblio.record_entry.undelete",
 353     signature => q/
 354         Un-deletes a record and sets active=true
 355         @param auth The authtoken
 356         @param record The record_id to ressurect
 357         @return 1 on success, Event on error.
 358     /
 359 );
 360 sub undelete_biblio_record_entry {
 361     my($self, $conn, $auth, $record_id) = @_;
 362     my $e = new_editor(authtoken=>$auth, xact=>1);
 363     return $e->die_event unless $e->checkauth;
 364     return $e->die_event unless $e->allowed('UPDATE_RECORD');
 365
 366     my $record = $e->retrieve_biblio_record_entry($record_id)
 367         or return $e->die_event;
 368     $record->deleted('f');
 369     $record->active('t');
 370
 371     # Set the leader/05 to indicate that the record has been corrected/revised
 372     my $marc = $record->marc();
 373     $marc =~ s{(<leader>.{5}).}{$1c};
 374     $record->marc($marc);
 375
 376     # no 2 non-deleted records can have the same tcn_value
 377     my $existing = $e->search_biblio_record_entry(
 378         {   deleted => 'f',
 379             tcn_value => $record->tcn_value,
 380             id => {'!=' => $record_id}
 381         }, {idlist => 1});
 382     return OpenILS::Event->new('TCN_EXISTS') if @$existing;
 383
 384     $e->update_biblio_record_entry($record) or return $e->die_event;
 385     $e->commit;
 386     return 1;
 387 }
 388
 389
 390 __PACKAGE__->register_method(
 391     method    => "biblio_record_xml_import",
 392     api_name  => "open-ils.cat.biblio.record.xml.import.override",
 393     signature => q/@see open-ils.cat.biblio.record.xml.import/);
 394
 395 __PACKAGE__->register_method(
 396     method    => "biblio_record_xml_import",
 397     api_name  => "open-ils.cat.biblio.record.xml.import",
 398     notes     => <<"    NOTES");
 399     Takes a marcxml record and imports the record into the database.  In this
 400     case, the marcxml record is assumed to be a complete record (i.e. valid
 401     MARC).  The title control number is taken from (whichever comes first)
 402     tags 001, 039[ab], 020a, 022a, 010, 035a and whichever does not already exist
 403     in the database.
 404     user_session must have IMPORT_MARC permissions
 405     NOTES
 406
 407
 408 sub biblio_record_xml_import {
 409     my( $self, $client, $authtoken, $xml, $source, $auto_tcn, $oargs, $strip_grps) = @_;
 410     my $e = new_editor(xact=>1, authtoken=>$authtoken);
 411     return $e->die_event unless $e->checkauth;
 412     return $e->die_event unless $e->allowed('IMPORT_MARC', $e->requestor->ws_ou);
 413
 414     if ($self->api_name =~ /override/) {
 415         $oargs = { all => 1 } unless defined $oargs;
 416     } else {
 417         $oargs = {};
 418     }
 419     my $record = OpenILS::Application::Cat::BibCommon->biblio_record_xml_import(
 420         $e, $xml, $source, $auto_tcn, $oargs, $strip_grps);
 421
 422     return $record if $U->event_code($record);
 423
 424     $e->commit;
 425
 426     return $record;
 427 }
 428
 429 __PACKAGE__->register_method(
 430     method        => "biblio_record_record_metadata",
 431     api_name      => "open-ils.cat.biblio.record.metadata.retrieve",
 432     authoritative => 1,
 433     argc          => 2, #(session_id, list of bre ids )
 434     notes         => "Returns a list of slim-downed bre objects based on the " .
 435                      "ids passed in",
 436 );
 437
 438 sub biblio_record_record_metadata {
 439     my( $self, $client, $authtoken, $ids ) = @_;
 440
 441     return [] unless $ids and @$ids;
 442
 443     my $editor = new_editor(authtoken => $authtoken);
 444     return $editor->event unless $editor->checkauth;
 445     return $editor->event unless $editor->allowed('VIEW_USER');
 446
 447     my @results;
 448
 449     for(@$ids) {
 450         return $editor->event unless
 451             my $rec = $editor->retrieve_biblio_record_entry($_);
 452         $rec->creator($editor->retrieve_actor_user($rec->creator));
 453         $rec->editor($editor->retrieve_actor_user($rec->editor));
 454         $rec->attrs($U->get_bre_attrs([$rec->id], $editor)->{$rec->id});
 455         $rec->clear_marc; # slim the record down
 456         push( @results, $rec );
 457     }
 458
 459     return \@results;
 460 }
 461
 462
 463
 464 __PACKAGE__->register_method(
 465     method    => "biblio_record_marc_cn",
 466     api_name  => "open-ils.cat.biblio.record.marc_cn.retrieve",
 467     argc      => 1, #(bib id )
 468     signature => {
 469         desc   => 'Extracts call number candidates from a bibliographic record',
 470         params => [
 471             {desc => 'Record ID', type => 'number'},
 472             {desc => '(Optional) Classification scheme ID', type => 'number'},
 473         ]
 474     },
 475     return => {desc => 'Hash of candidate call numbers identified by tag' }
 476 );
 477
 478 sub biblio_record_marc_cn {
 479     my( $self, $client, $id, $class ) = @_;
 480
 481     my $e = new_editor();
 482     my $marc = $e->retrieve_biblio_record_entry($id)->marc;
 483
 484     my $doc = XML::LibXML->new->parse_string($marc);
 485     $doc->documentElement->setNamespace( "http://www.loc.gov/MARC21/slim", "marc", 1 );
 486
 487     my @fields;
 488     my @res;
 489     if ($class) {
 490         @fields = split(/,/, $e->retrieve_asset_call_number_class($class)->field);
 491     } else {
 492         @fields = qw/050ab 055ab 060ab 070ab 080ab 082ab 086ab 088ab 090 092 096 098 099/;
 493     }
 494
 495     # Get field/subfield combos based on acnc value; for example "050ab,055ab"
 496
 497     foreach my $field (@fields) {
 498         my $tag = substr($field, 0, 3);
 499         $logger->debug("Tag = $tag");
 500         my @node = $doc->findnodes("//marc:datafield[\@tag='$tag']");
 501
 502         # Now parse the subfields and build up the subfield XPath
 503         my @subfields = split(//, substr($field, 3));
 504
 505         # If they give us no subfields to parse, default to just the 'a'
 506         if (!@subfields) {
 507             @subfields = ('a');
 508         }
 509         my $subxpath;
 510         foreach my $sf (@subfields) {
 511             $subxpath .= "\@code='$sf' or ";
 512         }
 513         $subxpath = substr($subxpath, 0, -4);
 514         $logger->debug("subxpath = $subxpath");
 515
 516         # Find the contents of the specified subfields
 517         foreach my $x (@node) {
 518             my $cn = $x->findvalue("marc:subfield[$subxpath]");
 519             push @res, {$tag => $cn} if ($cn);
 520         }
 521     }
 522
 523     return \@res;
 524 }
 525
 526 __PACKAGE__->register_method(
 527     method    => 'autogen_barcodes',
 528     api_name  => "open-ils.cat.item.barcode.autogen",
 529     signature => {
 530         desc   => 'Returns N generated barcodes following a specified barcode.',
 531         params => [
 532             {desc => 'Authentication token', type => 'string'},
 533             {desc => 'Barcode which the sequence should follow from', type => 'string'},
 534             {desc => 'Number of barcodes to generate', type => 'number'},
 535             {desc => 'Options hash.  Currently you can pass in checkdigit : false to disable the use of checkdigits.'}
 536         ],
 537         return => {desc => 'Array of generated barcodes'}
 538     }
 539 );
 540
 541 sub autogen_barcodes {
 542     my( $self, $client, $auth, $barcode, $num_of_barcodes, $options ) = @_;
 543     my $e = new_editor(authtoken => $auth);
 544     return $e->event unless $e->checkauth;
 545     return $e->event unless $e->allowed('UPDATE_COPY', $e->requestor->ws_ou);
 546     $options ||= {};
 547
 548     my $barcode_text = '';
 549     my $barcode_number = 0;
 550
 551     if ($barcode =~ /^(\D+)/) { $barcode_text = $1; }
 552     if ($barcode =~ /(\d+)$/) { $barcode_number = $1; }
 553
 554     my @res;
 555     for (my $i = 1; $i <= $num_of_barcodes; $i++) {
 556         my $calculated_barcode;
 557
 558         # default is to use checkdigits, so looking for an explicit false here
 559         if (defined $$options{'checkdigit'} && ! $$options{'checkdigit'}) {
 560             $calculated_barcode = $barcode_number + $i;
 561         } else {
 562             if ($barcode_number =~ /^\d{8}$/) {
 563                 $calculated_barcode = add_codabar_checkdigit($barcode_number + $i, 0);
 564             } elsif ($barcode_number =~ /^\d{9}$/) {
 565                 $calculated_barcode = add_codabar_checkdigit($barcode_number + $i*10, 1); # strip last digit
 566             } elsif ($barcode_number =~ /^\d{13}$/) {
 567                 $calculated_barcode = add_codabar_checkdigit($barcode_number + $i, 0);
 568             } elsif ($barcode_number =~ /^\d{14}$/) {
 569                 $calculated_barcode = add_codabar_checkdigit($barcode_number + $i*10, 1); # strip last digit
 570             } else {
 571                 $calculated_barcode = $barcode_number + $i;
 572             }
 573         }
 574         push @res, $barcode_text . $calculated_barcode;
 575     }
 576     return \@res
 577 }
 578
 579 # Codabar doesn't define a checkdigit algorithm, but this one is typically used by libraries.  gmcharlt++
 580 sub add_codabar_checkdigit {
 581     my $barcode = shift;
 582     my $strip_last_digit = shift;
 583
 584     return $barcode if $barcode =~ /\D/;
 585     $barcode = substr($barcode, 0, length($barcode)-1) if $strip_last_digit;
 586     my @digits = split //, $barcode;
 587     my $total = 0;
 588     for (my $i = 1; $i < length($barcode); $i+=2) { # for a 13/14 digit barcode, would expect 1,3,5,7,9,11
 589         $total += $digits[$i];
 590     }
 591     for (my $i = 0; $i < length($barcode); $i+=2) { # for a 13/14 digit barcode, would expect 0,2,4,6,8,10,12
 592         $total += (2 * $digits[$i] >= 10) ? (2 * $digits[$i] - 9) : (2 * $digits[$i]);
 593     }
 594     my $remainder = $total % 10;
 595     my $checkdigit = ($remainder == 0) ? $remainder : 10 - $remainder;
 596     return $barcode . $checkdigit;
 597 }
 598
 599 __PACKAGE__->register_method(
 600     method        => "orgs_for_title",
 601     authoritative => 1,
 602     api_name      => "open-ils.cat.actor.org_unit.retrieve_by_title"
 603 );
 604
 605 sub orgs_for_title {
 606     my( $self, $client, $record_id ) = @_;
 607
 608     my $vols = $U->simple_scalar_request(
 609         "open-ils.cstore",
 610         "open-ils.cstore.direct.asset.call_number.search.atomic",
 611         { record => $record_id, deleted => 'f' });
 612
 613     my $orgs = { map {$_->owning_lib => 1 } @$vols };
 614     return [ keys %$orgs ];
 615 }
 616
 617
 618 __PACKAGE__->register_method(
 619     method        => "retrieve_copies",
 620     authoritative => 1,
 621     api_name      => "open-ils.cat.asset.copy_tree.retrieve");
 622
 623 __PACKAGE__->register_method(
 624     method   => "retrieve_copies",
 625     api_name => "open-ils.cat.asset.copy_tree.global.retrieve");
 626
 627 # user_session may be null/undef
 628 sub retrieve_copies {
 629
 630     my( $self, $client, $user_session, $docid, @org_ids ) = @_;
 631
 632     if(ref($org_ids[0])) { @org_ids = @{$org_ids[0]}; }
 633
 634     $docid = "$docid";
 635
 636     # grabbing copy trees should be available for everyone..
 637     if(!@org_ids and $user_session) {
 638         my($user_obj, $evt) = OpenILS::Application::AppUtils->checkses($user_session);
 639         return $evt if $evt;
 640         @org_ids = ($user_obj->home_ou);
 641     }
 642
 643     if( $self->api_name =~ /global/ ) {
 644         return _build_volume_list( { record => $docid, deleted => 'f', label => { '<>' => '##URI##' } } );
 645
 646     } else {
 647
 648         my @all_vols;
 649         for my $orgid (@org_ids) {
 650             my $vols = _build_volume_list(
 651                     { record => $docid, owning_lib => $orgid, deleted => 'f', label => { '<>' => '##URI##' } } );
 652             push( @all_vols, @$vols );
 653         }
 654
 655         return \@all_vols;
 656     }
 657
 658     return undef;
 659 }
 660
 661
 662 sub _build_volume_list {
 663     my $search_hash = shift;
 664
 665     $search_hash->{deleted} = 'f';
 666     my $e = new_editor();
 667
 668     my $vols = $e->search_asset_call_number([
 669         $search_hash,
 670         {
 671             flesh => 1,
 672             flesh_fields => { acn => ['prefix','suffix','label_class'] },
 673             'order_by' => { 'acn' => 'oils_text_as_bytea(label_sortkey), oils_text_as_bytea(label), id, owning_lib' }
 674         }
 675     ]);
 676
 677     my @volumes;
 678
 679     for my $volume (@$vols) {
 680
 681         my $copies = $e->search_asset_copy([
 682             { call_number => $volume->id , deleted => 'f' },
 683             { flesh => 1, flesh_fields => { acp => ['stat_cat_entries','parts'] } }
 684         ]);
 685
 686         $copies = [ sort { $a->barcode cmp $b->barcode } @$copies  ];
 687
 688         for my $c (@$copies) {
 689             if( $c->status == OILS_COPY_STATUS_CHECKED_OUT ) {
 690                 $c->circulations(
 691                     $e->search_action_circulation(
 692                         [
 693                             { target_copy => $c->id },
 694                             {
 695                                 order_by => { circ => 'xact_start desc' },
 696                                 limit => 1
 697                             }
 698                         ]
 699                     )
 700                 )
 701             }
 702         }
 703
 704         $volume->copies($copies);
 705         push( @volumes, $volume );
 706     }
 707
 708     #$session->disconnect();
 709     return \@volumes;
 710
 711 }
 712
 713
 714 __PACKAGE__->register_method(
 715     method   => "fleshed_copy_update",
 716     api_name => "open-ils.cat.asset.copy.fleshed.batch.update",);
 717
 718 __PACKAGE__->register_method(
 719     method   => "fleshed_copy_update",
 720     api_name => "open-ils.cat.asset.copy.fleshed.batch.update.override",);
 721
 722
 723 sub fleshed_copy_update {
 724     my( $self, $conn, $auth, $copies, $delete_stats, $oargs, $create_parts ) = @_;
 725     return 1 unless ref $copies;
 726     my( $reqr, $evt ) = $U->checkses($auth);
 727     return $evt if $evt;
 728     my $editor = new_editor(requestor => $reqr, xact => 1);
 729     if ($self->api_name =~ /override/) {
 730         $oargs = { all => 1 } unless defined $oargs;
 731     } else {
 732         $oargs = {};
 733     }
 734     my $retarget_holds = [];
 735     $evt = OpenILS::Application::Cat::AssetCommon->update_fleshed_copies(
 736         $editor, $oargs, undef, $copies, $delete_stats, $retarget_holds, undef, $create_parts);
 737
 738     if( $evt ) {
 739         $logger->info("fleshed copy update failed with event: ".OpenSRF::Utils::JSON->perl2JSON($evt));
 740         $editor->rollback;
 741         return $evt;
 742     }
 743
 744     $editor->commit;
 745     $logger->info("fleshed copy update successfully updated ".scalar(@$copies)." copies");
 746     reset_hold_list($auth, $retarget_holds);
 747
 748     return 1;
 749 }
 750
 751 sub reset_hold_list {
 752     my($auth, $hold_ids) = @_;
 753     return unless @$hold_ids;
 754     $logger->info("reseting holds after copy status change: @$hold_ids");
 755     my $ses = OpenSRF::AppSession->create('open-ils.circ');
 756     $ses->request('open-ils.circ.hold.reset.batch', $auth, $hold_ids);
 757 }
 758
 759 __PACKAGE__->register_method(
 760     method    => "transfer_copies_to_volume",
 761     api_name  => "open-ils.cat.transfer_copies_to_volume",
 762     argc      => 3,
 763     signature => {
 764         desc   => 'Transfers specified copies to the specified call number, and changes Circ Lib to match the new Owning Lib.',
 765         params => [
 766             {desc => 'Authtoken', type => 'string'},
 767             {desc => 'Call Number ID', type => 'number'},
 768             {desc => 'Array of Copy IDs', type => 'array'},
 769         ]
 770     },
 771     return => {desc => '1 on success, Event on error'}
 772 );
 773
 774 __PACKAGE__->register_method(
 775     method   => "transfer_copies_to_volume",
 776     api_name => "open-ils.cat.transfer_copies_to_volume.override",);
 777
 778 sub transfer_copies_to_volume {
 779     my( $self, $conn, $auth, $volume, $copies, $oargs ) = @_;
 780     my $delete_stats = 1;
 781     my $force_delete_empty_bib = undef;
 782     my $create_parts = undef;
 783
 784     # initial tests
 785
 786     return 1 unless ref $copies;
 787     my( $reqr, $evt ) = $U->checkses($auth);
 788     return $evt if $evt;
 789     my $editor = new_editor(requestor => $reqr, xact => 1);
 790     if ($self->api_name =~ /override/) {
 791         $oargs = { all => 1 } unless defined $oargs;
 792     } else {
 793         $oargs = {};
 794     }
 795
 796     # does the volume exist?  good, we also need its owning_lib later
 797     my( $cn, $cn_evt ) = $U->fetch_callnumber( $volume, 0, $editor );
 798     return $cn_evt if $cn_evt;
 799
 800     # flesh and munge the copies
 801     my $fleshed_copies = [];
 802     my ($copy, $copy_evt);
 803     foreach my $copy_id ( @{ $copies } ) {
 804         ($copy, $copy_evt) = $U->fetch_copy($copy_id);
 805         return $copy_evt if $copy_evt;
 806         $copy->call_number( $volume );
 807         $copy->circ_lib( $cn->owning_lib() );
 808         $copy->ischanged( 't' );
 809         push @$fleshed_copies, $copy;
 810     }
 811
 812     # actual work
 813     my $retarget_holds = [];
 814     $evt = OpenILS::Application::Cat::AssetCommon->update_fleshed_copies(
 815         $editor, $oargs, undef, $fleshed_copies, $delete_stats, $retarget_holds, $force_delete_empty_bib, $create_parts);
 816
 817     if( $evt ) {
 818         $logger->info("copy to volume transfer failed with event: ".OpenSRF::Utils::JSON->perl2JSON($evt));
 819         $editor->rollback;
 820         return $evt;
 821     }
 822
 823     $editor->commit;
 824     $logger->info("copy to volume transfer successfully updated ".scalar(@$copies)." copies");
 825     reset_hold_list($auth, $retarget_holds);
 826
 827     return 1;
 828 }
 829
 830 __PACKAGE__->register_method(
 831     method    => 'in_db_merge',
 832     api_name  => 'open-ils.cat.biblio.records.merge',
 833     signature => q/
 834         Merges a group of records
 835         @param auth The login session key
 836         @param master The id of the record all other records should be merged into
 837         @param records Array of records to be merged into the master record
 838         @return 1 on success, Event on error.
 839     /
 840 );
 841
 842 sub in_db_merge {
 843     my( $self, $conn, $auth, $master, $records ) = @_;
 844
 845     my $editor = new_editor( authtoken => $auth, xact => 1 );
 846     return $editor->die_event unless $editor->checkauth;
 847     return $editor->die_event unless $editor->allowed('MERGE_BIB_RECORDS'); # TODO see below about record ownership
 848
 849     my $count = 0;
 850     for my $source ( @$records ) {
 851         #XXX we actually /will/ want to check perms for master and sources after record ownership exists
 852
 853         # This stored proc (asset.merge_record_assets(target,source)) has the side effects of
 854         # moving call_number, title-type (and some volume-type) hold_request and uri-mapping
 855         # objects from the source record to the target record, so must be called from within
 856         # a transaction.
 857
 858         $count += $editor->json_query({
 859             select => {
 860                 bre => [{
 861                     alias => 'count',
 862                     transform => 'asset.merge_record_assets',
 863                     column => 'id',
 864                     params => [$source]
 865                 }]
 866             },
 867             from   => 'bre',
 868             where  => { id => $master }
 869         })->[0]->{count}; # count of objects moved, of all types
 870
 871     }
 872
 873     $editor->commit;
 874     return $count;
 875 }
 876
 877 __PACKAGE__->register_method(
 878     method    => 'in_db_auth_merge',
 879     api_name  => 'open-ils.cat.authority.records.merge',
 880     signature => q/
 881         Merges a group of authority records
 882         @param auth The login session key
 883         @param master The id of the record all other records should be merged into
 884         @param records Array of records to be merged into the master record
 885         @return 1 on success, Event on error.
 886     /
 887 );
 888
 889 sub in_db_auth_merge {
 890     my( $self, $conn, $auth, $master, $records ) = @_;
 891
 892     my $editor = new_editor( authtoken => $auth, xact => 1 );
 893     return $editor->die_event unless $editor->checkauth;
 894     return $editor->die_event unless $editor->allowed('MERGE_AUTH_RECORDS'); # TODO see below about record ownership
 895
 896     my $count = 0;
 897     for my $source ( @$records ) {
 898         $count += $editor->json_query({
 899             select => {
 900                 are => [{
 901                     alias => 'count',
 902                     transform => 'authority.merge_records',
 903                     column => 'id',
 904                     params => [$source]
 905                 }]
 906             },
 907             from   => 'are',
 908             where  => { id => $master }
 909         })->[0]->{count}; # count of objects moved, of all types
 910     }
 911
 912     $editor->commit;
 913     return $count;
 914 }
 915
 916 __PACKAGE__->register_method(
 917     method   => "fleshed_volume_update",
 918     api_name => "open-ils.cat.asset.volume.fleshed.batch.update",);
 919
 920 __PACKAGE__->register_method(
 921     method   => "fleshed_volume_update",
 922     api_name => "open-ils.cat.asset.volume.fleshed.batch.update.override",);
 923
 924 sub fleshed_volume_update {
 925     my( $self, $conn, $auth, $volumes, $delete_stats, $options, $oargs ) = @_;
 926     my( $reqr, $evt ) = $U->checkses($auth);
 927     return $evt if $evt;
 928     $options ||= {};
 929
 930     if ($self->api_name =~ /override/) {
 931         $oargs = { all => 1 } unless defined $oargs;
 932     } else {
 933         $oargs = {};
 934     }
 935     my $editor = new_editor( requestor => $reqr, xact => 1 );
 936     my $retarget_holds = [];
 937     my $auto_merge_vols = $options->{auto_merge_vols};
 938     my $create_parts = $options->{create_parts};
 939
 940     for my $vol (@$volumes) {
 941         $logger->info("vol-update: investigating volume ".$vol->id);
 942
 943         $vol->editor($reqr->id);
 944         $vol->edit_date('now');
 945
 946         my $copies = $vol->copies;
 947         $vol->clear_copies;
 948
 949         $vol->editor($editor->requestor->id);
 950         $vol->edit_date('now');
 951
 952         if( $vol->isdeleted ) {
 953
 954             $logger->info("vol-update: deleting volume");
 955             return $editor->die_event unless
 956                 $editor->allowed('UPDATE_VOLUME', $vol->owning_lib);
 957
 958             if(my $evt = $assetcom->delete_volume($editor, $vol, $oargs, $$options{force_delete_copies})) {
 959                 $editor->rollback;
 960                 return $evt;
 961             }
 962
 963             return $editor->die_event unless
 964                 $editor->update_asset_call_number($vol);
 965
 966         } elsif( $vol->isnew ) {
 967             $logger->info("vol-update: creating volume");
 968             $evt = $assetcom->create_volume( $oargs, $editor, $vol );
 969             return $evt if $evt;
 970
 971         } elsif( $vol->ischanged ) {
 972             $logger->info("vol-update: update volume");
 973             my $resp = update_volume($vol, $editor, ($oargs->{all} or grep { $_ eq 'VOLUME_LABEL_EXISTS' } @{$oargs->{events}} or $auto_merge_vols));
 974             return $resp->{evt} if $resp->{evt};
 975             $vol = $resp->{merge_vol} if $resp->{merge_vol};
 976         }
 977
 978         # now update any attached copies
 979         if( $copies and @$copies and !$vol->isdeleted ) {
 980             $_->call_number($vol->id) for @$copies;
 981             $evt = $assetcom->update_fleshed_copies(
 982                 $editor, $oargs, $vol, $copies, $delete_stats, $retarget_holds, undef, $create_parts);
 983             return $evt if $evt;
 984         }
 985     }
 986
 987     $editor->finish;
 988     reset_hold_list($auth, $retarget_holds);
 989     return scalar(@$volumes);
 990 }
 991
 992
 993 sub update_volume {
 994     my $vol = shift;
 995     my $editor = shift;
 996     my $auto_merge = shift;
 997     my $evt;
 998     my $merge_vol;
 999
1000     return {evt => $editor->event} unless
1001         $editor->allowed('UPDATE_VOLUME', $vol->owning_lib);
1002
1003     return {evt => $evt}
1004         if ( $evt = OpenILS::Application::Cat::AssetCommon->org_cannot_have_vols($editor, $vol->owning_lib) );
1005
1006     my $vols = $editor->search_asset_call_number({
1007         owning_lib => $vol->owning_lib,
1008         record     => $vol->record,
1009         label      => $vol->label,
1010         prefix     => $vol->prefix,
1011         suffix     => $vol->suffix,
1012         deleted    => 'f',
1013         id         => {'!=' => $vol->id}
1014     });
1015
1016     if(@$vols) {
1017
1018         if($auto_merge) {
1019
1020             # If the auto-merge option is on, merge our updated volume into the existing
1021             # volume with the same record + owner + label.
1022             ($merge_vol, $evt) = OpenILS::Application::Cat::Merge::merge_volumes($editor, [$vol], $vols->[0]);
1023             return {evt => $evt, merge_vol => $merge_vol};
1024
1025         } else {
1026             return {evt => OpenILS::Event->new('VOLUME_LABEL_EXISTS', payload => $vol->id)};
1027         }
1028     }
1029
1030     return {evt => $editor->die_event} unless $editor->update_asset_call_number($vol);
1031     return {};
1032 }
1033
1034
1035
1036 __PACKAGE__->register_method (
1037     method   => 'delete_bib_record',
1038     api_name => 'open-ils.cat.biblio.record_entry.delete');
1039
1040 sub delete_bib_record {
1041     my($self, $conn, $auth, $rec_id) = @_;
1042     my $e = new_editor(xact=>1, authtoken=>$auth);
1043     return $e->die_event unless $e->checkauth;
1044     return $e->die_event unless $e->allowed('DELETE_RECORD', $e->requestor->ws_ou);
1045     my $vols = $e->search_asset_call_number({record=>$rec_id, deleted=>'f'});
1046     return OpenILS::Event->new('RECORD_NOT_EMPTY', payload=>$rec_id) if @$vols;
1047     my $evt = OpenILS::Application::Cat::BibCommon->delete_rec($e, $rec_id);
1048     if($evt) { $e->rollback; return $evt; }
1049     $e->commit;
1050     return 1;
1051 }
1052
1053
1054
1055 __PACKAGE__->register_method (
1056     method   => 'batch_volume_transfer',
1057     api_name => 'open-ils.cat.asset.volume.batch.transfer',
1058 );
1059
1060 __PACKAGE__->register_method (
1061     method   => 'batch_volume_transfer',
1062     api_name => 'open-ils.cat.asset.volume.batch.transfer.override',
1063 );
1064
1065
1066 sub batch_volume_transfer {
1067     my( $self, $conn, $auth, $args, $oargs ) = @_;
1068
1069     my $evt;
1070     my $rec     = $$args{docid};
1071     my $o_lib   = $$args{lib};
1072     my $vol_ids = $$args{volumes};
1073
1074     my $override = 1 if $self->api_name =~ /override/;
1075     $oargs = { all => 1 } unless defined $oargs;
1076
1077     $logger->info("merge: transferring volumes to lib=$o_lib and record=$rec");
1078
1079     my $e = new_editor(authtoken => $auth, xact =>1);
1080     return $e->event unless $e->checkauth;
1081     return $e->event unless $e->allowed('UPDATE_VOLUME', $o_lib);
1082
1083     my $dorg = $e->retrieve_actor_org_unit($o_lib)
1084         or return $e->event;
1085
1086     my $ou_type = $e->retrieve_actor_org_unit_type($dorg->ou_type)
1087         or return $e->event;
1088
1089     return $evt if ( $evt = OpenILS::Application::Cat::AssetCommon->org_cannot_have_vols($e, $o_lib) );
1090
1091     my $vols = $e->batch_retrieve_asset_call_number($vol_ids);
1092     my @seen;
1093
1094    my @rec_ids;
1095
1096     for my $vol (@$vols) {
1097
1098         # if we've already looked at this volume, go to the next
1099         next if !$vol or grep { $vol->id == $_ } @seen;
1100
1101         # grab all of the volumes in the list that have
1102         # the same label so they can be merged
1103         my @all = grep { $_->label eq $vol->label } @$vols;
1104
1105         # take note of the fact that we've looked at this set of volumes
1106         push( @seen, $_->id ) for @all;
1107         push( @rec_ids, $_->record ) for @all;
1108
1109         # for each volume, see if there are any copies that have a
1110         # remote circ_lib (circ_lib != vol->owning_lib and != $o_lib ).
1111         # if so, warn them
1112         unless( $override && ($oargs->{all} || grep { $_ eq 'COPY_REMOTE_CIRC_LIB' } @{$oargs->{events}}) ) {
1113             for my $v (@all) {
1114
1115                 $logger->debug("merge: searching for copies with remote circ_lib for volume ".$v->id);
1116                 my $args = {
1117                     call_number => $v->id,
1118                     circ_lib    => { "not in" => [ $o_lib, $v->owning_lib ] },
1119                     deleted     => 'f'
1120                 };
1121
1122                 my $copies = $e->search_asset_copy($args, {idlist=>1});
1123
1124                 # if the copy's circ_lib matches the destination lib,
1125                 # that's ok too
1126                 return OpenILS::Event->new('COPY_REMOTE_CIRC_LIB') if @$copies;
1127             }
1128         }
1129
1130         # see if there is a volume at the destination lib that
1131         # already has the requested label
1132         my $existing_vol = $e->search_asset_call_number(
1133             {
1134                 label      => $vol->label,
1135                 prefix     => $vol->prefix,
1136                 suffix     => $vol->suffix,
1137                 record     => $rec,
1138                 owning_lib => $o_lib,
1139                 deleted    => 'f'
1140             }
1141         )->[0];
1142
1143         if( $existing_vol ) {
1144
1145             if( grep { $_->id == $existing_vol->id } @all ) {
1146                 # this volume is already accounted for in our list of volumes to merge
1147                 $existing_vol = undef;
1148
1149             } else {
1150                 # this volume exists on the destination record/owning_lib and must
1151                 # be used as the destination for merging
1152                 $logger->debug("merge: volume already exists at destination record: ".
1153                     $existing_vol->id.' : '.$existing_vol->label) if $existing_vol;
1154             }
1155         }
1156
1157         if( @all > 1 || $existing_vol ) {
1158             $logger->info("merge: found collisions in volume transfer");
1159             my @args = ($e, \@all);
1160             @args = ($e, \@all, $existing_vol) if $existing_vol;
1161             ($vol, $evt) = OpenILS::Application::Cat::Merge::merge_volumes(@args);
1162             return $evt if $evt;
1163         }
1164
1165         if( !$existing_vol ) {
1166
1167             $vol->owning_lib($o_lib);
1168             $vol->record($rec);
1169             $vol->editor($e->requestor->id);
1170             $vol->edit_date('now');
1171
1172             $logger->info("merge: updating volume ".$vol->id);
1173             $e->update_asset_call_number($vol) or return $e->event;
1174
1175         } else {
1176             $logger->info("merge: bypassing volume update because existing volume used as target");
1177         }
1178
1179         # regardless of what volume was used as the destination,
1180         # update any copies that have moved over to the new lib
1181         my $copies = $e->search_asset_copy({call_number=>$vol->id, deleted => 'f'});
1182
1183         # update circ lib on the copies - make this a method flag?
1184         for my $copy (@$copies) {
1185             next if $copy->circ_lib == $o_lib;
1186             $logger->info("merge: transfer moving circ lib on copy ".$copy->id);
1187             $copy->circ_lib($o_lib);
1188             $copy->editor($e->requestor->id);
1189             $copy->edit_date('now');
1190             $e->update_asset_copy($copy) or return $e->event;
1191         }
1192
1193         # Now see if any empty records need to be deleted after all of this
1194
1195         for(@rec_ids) {
1196             $logger->debug("merge: seeing if we should delete record $_...");
1197             $evt = OpenILS::Application::Cat::BibCommon->delete_rec($e, $_)
1198                 if OpenILS::Application::Cat::BibCommon->title_is_empty($e, $_);
1199             return $evt if $evt;
1200         }
1201     }
1202
1203     $logger->info("merge: transfer succeeded");
1204     $e->commit;
1205     return 1;
1206 }
1207
1208
1209
1210
1211 __PACKAGE__->register_method(
1212     api_name => 'open-ils.cat.call_number.find_or_create',
1213     method   => 'find_or_create_volume',
1214 );
1215
1216 sub find_or_create_volume {
1217     my( $self, $conn, $auth, $label, $record_id, $org_id, $prefix, $suffix, $label_class ) = @_;
1218     my $e = new_editor(authtoken=>$auth, xact=>1);
1219     return $e->die_event unless $e->checkauth;
1220     my ($vol, $evt, $exists) =
1221         OpenILS::Application::Cat::AssetCommon->find_or_create_volume($e, $label, $record_id, $org_id, $prefix, $suffix, $label_class);
1222     return $evt if $evt;
1223     $e->rollback if $exists;
1224     $e->commit if $vol;
1225     return { 'acn_id' => $vol->id, 'existed' => $exists };
1226 }
1227
1228
1229 __PACKAGE__->register_method(
1230     method    => "create_serial_record_xml",
1231     api_name  => "open-ils.cat.serial.record.xml.create.override",
1232     signature => q/@see open-ils.cat.serial.record.xml.create/);
1233
1234 __PACKAGE__->register_method(
1235     method    => "create_serial_record_xml",
1236     api_name  => "open-ils.cat.serial.record.xml.create",
1237     signature => q/
1238         Inserts a new serial record with the given XML
1239     /
1240 );
1241
1242 sub create_serial_record_xml {
1243     my( $self, $client, $login, $source, $owning_lib, $record_id, $xml, $oargs ) = @_;
1244
1245     my $override = 1 if $self->api_name =~ /override/; # not currently used
1246     $oargs = { all => 1 } unless defined $oargs; # Not currently used, but here for consistency.
1247
1248     my $e = new_editor(xact=>1, authtoken=>$login);
1249     return $e->die_event unless $e->checkauth;
1250     return $e->die_event unless $e->allowed('CREATE_MFHD_RECORD', $owning_lib);
1251
1252     # Auto-populate the location field of a placeholder MFHD record with the library name
1253     my $aou = $e->retrieve_actor_org_unit($owning_lib) or return $e->die_event;
1254
1255     my $mfhd = Fieldmapper::serial::record_entry->new;
1256
1257     $mfhd->source($source) if $source;
1258     $mfhd->record($record_id);
1259     $mfhd->creator($e->requestor->id);
1260     $mfhd->editor($e->requestor->id);
1261     $mfhd->create_date('now');
1262     $mfhd->edit_date('now');
1263     $mfhd->owning_lib($owning_lib);
1264
1265     # If the caller did not pass in MFHD XML, create a placeholder record.
1266     # The placeholder will only contain the name of the owning library.
1267     # The goal is to generate common patterns for the caller in the UI that
1268     # then get passed in here.
1269     if (!$xml) {
1270         my $aou_name = $aou->name;
1271         $xml = <<HERE;
1272 <record
1273  xsi:schemaLocation="http://www.loc.gov/MARC21/slim http://www.loc.gov/standards/marcxml/schema/MARC21slim.xsd"
1274  xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance"
1275  xmlns="http://www.loc.gov/MARC21/slim">
1276 <leader>00307ny  a22001094  4500</leader>
1277 <controlfield tag="001">42153</controlfield>
1278 <controlfield tag="005">20090601182414.0</controlfield>
1279 <controlfield tag="004">$record_id</controlfield>
1280 <controlfield tag="008">      4u####8###l# 4   uueng1      </controlfield>
1281 <datafield tag="852" ind1=" " ind2=" "> <subfield code="b">$aou_name</subfield></datafield>
1282 </record>
1283 HERE
1284     }
1285     my $marcxml = XML::LibXML->new->parse_string($xml);
1286     $marcxml->documentElement->setNamespace("http://www.loc.gov/MARC21/slim", "marc", 1 );
1287     $marcxml->documentElement->setNamespace("http://www.loc.gov/MARC21/slim");
1288
1289     $mfhd->marc($U->entityize($marcxml->documentElement->toString));
1290
1291     $e->create_serial_record_entry($mfhd) or return $e->die_event;
1292
1293     $e->commit;
1294     return $mfhd->id;
1295 }
1296
1297 __PACKAGE__->register_method(
1298     method   => "create_update_asset_copy_template",
1299     api_name => "open-ils.cat.asset.copy_template.create_or_update"
1300 );
1301
1302 sub create_update_asset_copy_template {
1303     my ($self, $client, $authtoken, $act) = @_;
1304
1305     my $e = new_editor("xact" => 1, "authtoken" => $authtoken);
1306     return $e->die_event unless $e->checkauth;
1307     return $e->die_event unless $e->allowed(
1308         "ADMIN_ASSET_COPY_TEMPLATE", $act->owning_lib
1309     );
1310
1311     $act->editor($e->requestor->id);
1312     $act->edit_date("now");
1313
1314     my $retval;
1315     if (!$act->id) {
1316         $act->creator($e->requestor->id);
1317         $act->create_date("now");
1318
1319         $e->create_asset_copy_template($act) or return $e->die_event;
1320         $retval = $e->data;
1321     } else {
1322         $e->update_asset_copy_template($act) or return $e->die_event;
1323         $retval = $e->retrieve_asset_copy_template($e->data);
1324     }
1325     $e->commit and return $retval;
1326 }
1327
1328 __PACKAGE__->register_method(
1329     method      => "acn_sms_msg",
1330     api_name    => "open-ils.cat.acn.send_sms_text",
1331     signature   => q^
1332         Send an SMS text from an A/T template for specified call numbers.
1333
1334         First parameter is null or an auth token (whether a null is allowed
1335         depends on the sms.disable_authentication_requirement.callnumbers OU
1336         setting).
1337
1338         Second parameter is the id of the context org.
1339
1340         Third parameter is the code of the SMS carrier from the
1341         config.sms_carrier table.
1342
1343         Fourth parameter is the SMS number.
1344
1345         Fifth parameter is the ACN id's to target, though currently only the
1346         first ACN is used by the template (and the UI is only sending one).
1347     ^
1348 );
1349
1350 sub acn_sms_msg {
1351     my($self, $conn, $auth, $org_id, $carrier, $number, $target_ids) = @_;
1352
1353     my $sms_enable = $U->ou_ancestor_setting_value(
1354         $org_id || $U->get_org_tree->id,
1355         'sms.enable'
1356     );
1357     # We could maybe make a Validator for this on the templates
1358     if (! $U->is_true($sms_enable)) {
1359         return -1;
1360     }
1361
1362     my $disable_auth = $U->ou_ancestor_setting_value(
1363         $org_id || $U->get_org_tree->id,
1364         'sms.disable_authentication_requirement.callnumbers'
1365     );
1366
1367     my $e = new_editor(
1368         (defined $auth)
1369         ? (authtoken => $auth, xact => 1)
1370         : (xact => 1)
1371     );
1372     return $e->event unless $disable_auth || $e->checkauth;
1373
1374     my $targets = $e->batch_retrieve_asset_call_number($target_ids);
1375
1376     $e->rollback; # FIXME using transaction because of pgpool/slony setups, but not
1377                   # simply making this method authoritative because of weirdness
1378                   # with transaction handling in A/T code that causes rollback
1379                   # failure down the line if handling many targets
1380
1381     return undef unless @$targets;
1382     return $U->fire_object_event(
1383         undef,                    # event_def
1384         'acn.format.sms_text',    # hook
1385         $targets,
1386         $org_id,
1387         undef,                    # granularity
1388         {                         # user_data
1389             sms_carrier => $carrier,
1390             sms_notify => $number
1391         }
1392     );
1393 }
1394
1395
1396
1397 __PACKAGE__->register_method(
1398     method    => "fixed_field_values_by_rec_type",
1399     api_name  => "open-ils.cat.biblio.fixed_field_values.by_rec_type",
1400     argc      => 2,
1401     signature => {
1402         desc   => 'Given a record type (as in cmfpm.rec_type), return fixed fields and their possible values as known to the DB',
1403         params => [
1404             {desc => 'Record Type', type => 'string'},
1405             {desc => '(Optional) Fixed field', type => 'string'},
1406         ]
1407     },
1408     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' }
1409 );
1410
1411
1412 sub fixed_field_values_by_rec_type {
1413     my ($self, $conn, $rec_type, $fixed_field) = @_;
1414
1415     my $e = new_editor;
1416     my $values = $e->json_query({
1417         select => {
1418             crad  => ["fixed_field"],
1419             ccvm  => [qw/code value/],
1420             cmfpm => [qw/length default_val/],
1421         },
1422         distinct => 1,
1423         from => {
1424             ccvm => {
1425                 crad => {
1426                     join => {
1427                         cmfpm => {
1428                             fkey => "fixed_field",
1429                             field => "fixed_field"
1430                         }
1431                     }
1432                 }
1433             }
1434         },
1435         where => {
1436             "+cmfpm" => {rec_type => $rec_type},
1437             defined $fixed_field ?
1438                 ("+crad" => {fixed_field => $fixed_field}) : ()
1439         },
1440         order_by => [
1441             {class => "crad", field => "fixed_field"},
1442             {class => "ccvm", field => "code"}
1443         ]
1444     }) or return $e->die_event;
1445
1446     my $result = {};
1447     for my $row (@$values) {
1448         $result->{$row->{fixed_field}} ||= [];
1449         push @{$result->{$row->{fixed_field}}}, [@$row{qw/code value length default_val/}];
1450     }
1451
1452     return $result;
1453 }
1454
1455 __PACKAGE__->register_method(
1456     method    => "retrieve_tag_table",
1457     api_name  => "open-ils.cat.tag_table.all.retrieve.local",
1458     stream    => 1,
1459     argc      => 3,
1460     signature => {
1461         desc   => "Retrieve set of MARC tags, subfields, and indicator values for the user's OU",
1462         params => [
1463             {desc => 'Authtoken', type => 'string'},
1464             {desc => 'MARC Format', type => 'string'},
1465             {desc => 'MARC Record Type', type => 'string'},
1466         ]
1467     },
1468     return => {desc => 'Structure representing the tag table available to that user', type => 'object' }
1469 );
1470 __PACKAGE__->register_method(
1471     method    => "retrieve_tag_table",
1472     api_name  => "open-ils.cat.tag_table.all.retrieve.stock",
1473     stream    => 1,
1474     argc      => 3,
1475     signature => {
1476         desc   => 'Retrieve set of MARC tags, subfields, and indicator values for stock MARC standard',
1477         params => [
1478             {desc => 'Authtoken', type => 'string'},
1479             {desc => 'MARC Format', type => 'string'},
1480             {desc => 'MARC Record Type', type => 'string'},
1481         ]
1482     },
1483     return => {desc => 'Structure representing the stock tag table', type => 'object' }
1484 );
1485 __PACKAGE__->register_method(
1486     method    => "retrieve_tag_table",
1487     api_name  => "open-ils.cat.tag_table.field_list.retrieve.local",
1488     stream    => 1,
1489     argc      => 3,
1490     signature => {
1491         desc   => "Retrieve set of MARC tags for available to the user's OU",
1492         params => [
1493             {desc => 'Authtoken', type => 'string'},
1494             {desc => 'MARC Format', type => 'string'},
1495             {desc => 'MARC Record Type', type => 'string'},
1496         ]
1497     },
1498     return => {desc => 'Structure representing the tags available to that user', type => 'object' }
1499 );
1500 __PACKAGE__->register_method(
1501     method    => "retrieve_tag_table",
1502     api_name  => "open-ils.cat.tag_table.field_list.retrieve.stock",
1503     stream    => 1,
1504     argc      => 3,
1505     signature => {
1506         desc   => 'Retrieve set of MARC tags for stock MARC standard',
1507         params => [
1508             {desc => 'Authtoken', type => 'string'},
1509             {desc => 'MARC Format', type => 'string'},
1510             {desc => 'MARC Record Type', type => 'string'},
1511         ]
1512     },
1513     return => {desc => 'Structure representing the stock MARC tags', type => 'object' }
1514 );
1515
1516 sub retrieve_tag_table {
1517     my( $self, $conn, $auth, $marc_format, $marc_record_type ) = @_;
1518     my $e = new_editor( authtoken=>$auth, xact=>1 );
1519     return $e->die_event unless $e->checkauth;
1520     return $e->die_event unless $e->allowed('UPDATE_MARC', $e->requestor->ws_ou);
1521
1522     my $field_list_only = ($self->api_name =~ /\.field_list\./) ? 1 : 0;
1523     my $context_ou;
1524     if ($self->api_name =~ /\.local$/) {
1525         $context_ou = $e->requestor->ws_ou;
1526     }
1527
1528     my %sf_by_tag;
1529     unless ($field_list_only) {
1530         my $subfields = $e->json_query(
1531             { from => [ 'config.ou_marc_subfields', 1, $marc_record_type, $context_ou ] }
1532         );
1533         foreach my $sf (@$subfields) {
1534             my $sf_data = {
1535                 code        => $sf->{code},
1536                 description => $sf->{description},
1537                 mandatory   => $sf->{mandatory},
1538                 repeatable   => $sf->{repeatable},
1539             };
1540             if ($sf->{value_ctype}) {
1541                 $sf_data->{value_list} = $e->json_query({
1542                     select => { ccvm => [
1543                                             'code',
1544                                             { column => 'value', alias => 'description' }
1545                                         ]
1546                               },
1547                     from   => 'ccvm',
1548                     where  => { ctype => $sf->{value_ctype} },
1549                     order_by => { ccvm => { code => {} } },
1550                 });
1551             }
1552             push @{ $sf_by_tag{$sf->{tag}} }, $sf_data;
1553         }
1554     }
1555
1556     my $fields = $e->json_query(
1557         { from => [ 'config.ou_marc_fields', 1, $marc_record_type, $context_ou ] }
1558     );
1559
1560     foreach my $field (@$fields) {
1561         next if $field->{hidden} eq 't';
1562         unless ($field_list_only) {
1563             my $tag = $field->{tag};
1564             if ($tag ge '010') {
1565                 for my $pos (1..2) {
1566                     my $ind_ccvm_key = "${marc_format}_${marc_record_type}_${tag}_ind_${pos}";
1567                     my $indvals = $e->json_query({
1568                         select => { ccvm => [
1569                                                 'code',
1570                                                 { column => 'value', alias => 'description' }
1571                                             ]
1572                                   },
1573                         from   => 'ccvm',
1574                         where  => { ctype => $ind_ccvm_key }
1575                     });
1576                     next unless defined($indvals);
1577                     $field->{"ind$pos"} = $indvals;
1578                 }
1579                 $field->{subfields} = exists($sf_by_tag{$tag}) ? $sf_by_tag{$tag} : [];
1580             }
1581         }
1582         $conn->respond($field);
1583     }
1584 }
1585
1586 1;
1587
1588 # vi:et:ts=4:sw=4