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

   1 #!/usr/bin/perl
   2
   3 # This program is free software; you can redistribute it and/or
   4 # modify it under the terms of the GNU General Public License
   5 # as published by the Free Software Foundation; either version 2
   6 # of the License, or (at your option) any later version.
   7 #
   8 # This program is distributed in the hope that it will be useful,
   9 # but WITHOUT ANY WARRANTY; without even the implied warranty of
  10 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  11 # GNU General Public License for more details.
  12 #
  13 # You should have received a copy of the GNU General Public License
  14 # along with this program; if not, write to the Free Software
  15 # Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301, USA.
  16
  17 =head1 NAME
  18
  19 OpenILS::Application::Serial - Performs serials-related tasks such as receiving issues and generating predictions
  20
  21 =head1 SYNOPSIS
  22
  23 TBD
  24
  25 =head1 DESCRIPTION
  26
  27 TBD
  28
  29 =head1 AUTHOR
  30
  31 Dan Wells, dbw2@calvin.edu
  32
  33 =cut
  34
  35 package OpenILS::Application::Serial;
  36
  37 use strict;
  38 use warnings;
  39
  40
  41 use OpenILS::Application;
  42 use base qw/OpenILS::Application/;
  43 use OpenILS::Application::AppUtils;
  44 use OpenILS::Event;
  45 use OpenSRF::AppSession;
  46 use OpenSRF::Utils qw/:datetime/;
  47 use OpenSRF::Utils::Logger qw/:logger/;
  48 use OpenILS::Utils::CStoreEditor q/:funcs/;
  49 use OpenILS::Utils::Fieldmapper;
  50 use OpenILS::Utils::MFHD;
  51 use DateTime::Format::ISO8601;
  52 use MARC::File::XML (BinaryEncoding => 'utf8');
  53
  54 use OpenILS::Application::Serial::OPAC;
  55
  56 my $U = 'OpenILS::Application::AppUtils';
  57 my @MFHD_NAMES = ('basic','supplement','index');
  58 my %MFHD_NAMES_BY_TAG = (  '853' => $MFHD_NAMES[0],
  59                         '863' => $MFHD_NAMES[0],
  60                         '854' => $MFHD_NAMES[1],
  61                         '864' => $MFHD_NAMES[1],
  62                         '855' => $MFHD_NAMES[2],
  63                         '865' => $MFHD_NAMES[2] );
  64 my %MFHD_TAGS_BY_NAME = (  $MFHD_NAMES[0] => '853',
  65                         $MFHD_NAMES[1] => '854',
  66                         $MFHD_NAMES[2] => '855');
  67 my $_strp_date = new DateTime::Format::Strptime(pattern => '%F');
  68
  69 # helper method for conforming dates to ISO8601
  70 sub _cleanse_dates {
  71     my $item = shift;
  72     my $fields = shift;
  73
  74     foreach my $field (@$fields) {
  75         $item->$field(OpenSRF::Utils::clense_ISO8601($item->$field)) if $item->$field;
  76     }
  77     return 0;
  78 }
  79
  80 sub _get_mvr {
  81     $U->simplereq(
  82         "open-ils.search",
  83         "open-ils.search.biblio.record.mods_slim.retrieve",
  84         @_
  85     );
  86 }
  87
  88
  89 ##########################################################################
  90 # item methods
  91 #
  92 __PACKAGE__->register_method(
  93     method    => "create_item_safely",
  94     api_name  => "open-ils.serial.item.create",
  95     api_level => 1,
  96     stream    => 1,
  97     argc      => 3,
  98     signature => {
  99         desc => q/Creates any number of items, respecting only a few of the
 100         submitted fields, as the user shouldn't be able to freely set certain
 101         ones/,
 102         params => [
 103             {name=> "authtoken", desc => "Authtoken for current user session",
 104                 type => "string"},
 105             {name => "item", desc => "serial item",
 106                 type => "object", class => "sitem"},
 107             {name => "count",
 108                 desc => "optional: how many items to make " .
 109                     "(default 1; 1-100 permitted)",
 110                 type => "number"}
 111         ],
 112         return => {
 113             desc => "created items (a stream of them)",
 114             type => "object", class => "sitem"
 115         }
 116     }
 117 );
 118 __PACKAGE__->register_method(
 119     method    => "update_item_safely",
 120     api_name  => "open-ils.serial.item.update",
 121     api_level => 1,
 122     stream    => 1,
 123     argc      => 2,
 124     signature => {
 125         desc => q/Edit a serial item, respecting only a few of the
 126         submitted fields, as the user shouldn't be able to freely set certain
 127         ones/,
 128         params => [
 129             {name=> "authtoken", desc => "Authtoken for current user session",
 130                 type => "string"},
 131             {name => "item", desc => "serial item",
 132                 type => "object", class => "sitem"},
 133         ],
 134         return => {
 135             desc => "created item", type => "object", class => "sitem"
 136         }
 137     }
 138 );
 139
 140 sub _set_safe_item_fields {
 141     my $dest = shift;
 142     my $source = shift;
 143     my $requestor_id = shift;
 144     # extra fields remain in @_
 145
 146     $dest->edit_date("now");
 147     $dest->editor($requestor_id);
 148
 149     my @fields = qw/date_expected date_received status/;
 150
 151     for my $field (@fields, @_) {
 152         $dest->$field($source->$field);
 153     }
 154 }
 155
 156 sub update_item_safely {
 157     my ($self, $client, $auth, $item) = @_;
 158
 159     my $e = new_editor("xact" => 1, "authtoken" => $auth);
 160     $e->checkauth or return $e->die_event;
 161
 162     my $orig = $e->retrieve_serial_item([
 163         $item->id, {
 164             "flesh" => 2, "flesh_fields" => {
 165                 "sitem" => ["stream"], "sstr" => ["distribution"]
 166             }
 167         }
 168     ]) or return $e->die_event;
 169
 170     return $e->die_event unless $e->allowed(
 171         "ADMIN_SERIAL_ITEM", $orig->stream->distribution->holding_lib
 172     );
 173
 174     _set_safe_item_fields($orig, $item, $e->requestor->id);
 175     $e->update_serial_item($orig) or return $e->die_event;
 176
 177     $client->respond($e->retrieve_serial_item($item->id));
 178     $e->commit or return $e->die_event;
 179     undef;
 180 }
 181
 182 sub create_item_safely {
 183     my ($self, $client, $auth, $item, $count) = @_;
 184
 185     $count = int $count;
 186     $count ||= 1;
 187     return new OpenILS::Event(
 188         "BAD_PARAMS", note => "Count should be from 1 to 100"
 189     ) unless $count >= 1 and $count <= 100;
 190
 191     my $e = new_editor("xact" => 1, "authtoken" => $auth);
 192     $e->checkauth or return $e->die_event;
 193
 194     my $stream = $e->retrieve_serial_stream([
 195         $item->stream, {
 196             "flesh" => 1, "flesh_fields" => {"sstr" => ["distribution"]}
 197         }
 198     ]) or return $e->die_event;
 199
 200     return $e->die_event unless $e->allowed(
 201         "ADMIN_SERIAL_ITEM", $stream->distribution->holding_lib
 202     );
 203
 204     for (my $i = 0; $i < $count; $i++) {
 205         my $actual = new Fieldmapper::serial::item;
 206         $actual->creator($e->requestor->id);
 207         _set_safe_item_fields(
 208             $actual, $item, $e->requestor->id, "issuance", "stream"
 209         );
 210
 211         $e->create_serial_item($actual) or return $e->die_event;
 212         $client->respond($e->data);
 213     }
 214
 215     $e->commit or return $e->die_event;
 216     undef;
 217 }
 218
 219 __PACKAGE__->register_method(
 220     method    => 'fleshed_item_alter',
 221     api_name  => 'open-ils.serial.item.fleshed.batch.update',
 222     api_level => 1,
 223     argc      => 2,
 224     signature => {
 225         desc     => 'Receives an array of one or more items and updates the database as needed',
 226         'params' => [ {
 227                  name => 'authtoken',
 228                  desc => 'Authtoken for current user session',
 229                  type => 'string'
 230             },
 231             {
 232                  name => 'items',
 233                  desc => 'Array of fleshed items',
 234                  type => 'array'
 235             }
 236
 237         ],
 238         'return' => {
 239             desc => 'Returns 1 if successful, event if failed',
 240             type => 'mixed'
 241         }
 242     }
 243 );
 244
 245 sub fleshed_item_alter {
 246     my( $self, $conn, $auth, $items ) = @_;
 247     return 1 unless ref $items;
 248     my( $reqr, $evt ) = $U->checkses($auth);
 249     return $evt if $evt;
 250     my $editor = new_editor(requestor => $reqr, xact => 1);
 251     my $override = $self->api_name =~ /override/;
 252
 253     my %found_sdist_ids;
 254     my %found_sstr_ids;
 255     for my $item (@$items) {
 256         my $sstr_id = ref $item->stream ? $item->stream->id : $item->stream;
 257         if (!exists($found_sstr_ids{$sstr_id})) {
 258             my $sstr;
 259             if (ref $item->stream) {
 260                 $sstr = $item->stream;
 261             } else {
 262                 $sstr = $editor->retrieve_serial_stream($item->stream) or return $editor->die_event;
 263             }
 264             if (!exists($found_sdist_ids{$sstr->distribution})) {
 265                 my $sdist = $editor->retrieve_serial_distribution($sstr->distribution) or return $editor->die_event;
 266                 return $editor->die_event unless
 267                     $editor->allowed("ADMIN_SERIAL_STREAM", $sdist->holding_lib);
 268                 $found_sdist_ids{$sstr->distribution} = 1;
 269             }
 270             $found_sstr_ids{$sstr_id} = 1;
 271         }
 272
 273         $item->editor($editor->requestor->id);
 274         $item->edit_date('now');
 275
 276         if( $item->isdeleted ) {
 277             $evt = _delete_sitem( $editor, $override, $item);
 278         } elsif( $item->isnew ) {
 279             # TODO: reconsider this
 280             # if the item has a new issuance, create the issuance first
 281             if (ref $item->issuance eq 'Fieldmapper::serial::issuance' and $item->issuance->isnew) {
 282                 fleshed_issuance_alter($self, $conn, $auth, [$item->issuance]);
 283             }
 284             _cleanse_dates($item, ['date_expected','date_received']);
 285             $evt = _create_sitem( $editor, $item );
 286         } else {
 287             _cleanse_dates($item, ['date_expected','date_received']);
 288             $evt = _update_sitem( $editor, $override, $item );
 289         }
 290     }
 291
 292     if( $evt ) {
 293         $logger->info("fleshed item-alter failed with event: ".OpenSRF::Utils::JSON->perl2JSON($evt));
 294         $editor->rollback;
 295         return $evt;
 296     }
 297     $logger->debug("item-alter: done updating item batch");
 298     $editor->commit;
 299     $logger->info("fleshed item-alter successfully updated ".scalar(@$items)." items");
 300     return 1;
 301 }
 302
 303 sub _delete_sitem {
 304     my ($editor, $override, $item) = @_;
 305     $logger->info("item-alter: delete item ".OpenSRF::Utils::JSON->perl2JSON($item));
 306     return $editor->event unless $editor->delete_serial_item($item);
 307     return 0;
 308 }
 309
 310 sub _create_sitem {
 311     my ($editor, $item) = @_;
 312
 313     $item->creator($editor->requestor->id);
 314     $item->create_date('now');
 315
 316     $logger->info("item-alter: new item ".OpenSRF::Utils::JSON->perl2JSON($item));
 317     return $editor->event unless $editor->create_serial_item($item);
 318     return 0;
 319 }
 320
 321 sub _update_sitem {
 322     my ($editor, $override, $item) = @_;
 323
 324     $logger->info("item-alter: retrieving item ".$item->id);
 325     my $orig_item = $editor->retrieve_serial_item($item->id);
 326
 327     $logger->info("item-alter: original item ".OpenSRF::Utils::JSON->perl2JSON($orig_item));
 328     $logger->info("item-alter: updated item ".OpenSRF::Utils::JSON->perl2JSON($item));
 329     return $editor->event unless $editor->update_serial_item($item);
 330     return 0;
 331 }
 332
 333 __PACKAGE__->register_method(
 334     method  => "fleshed_serial_item_retrieve_batch",
 335     authoritative => 1,
 336     api_name    => "open-ils.serial.item.fleshed.batch.retrieve"
 337 );
 338
 339 sub fleshed_serial_item_retrieve_batch {
 340     my( $self, $client, $ids ) = @_;
 341 # FIXME: permissions?
 342     $logger->info("Fetching fleshed serial items @$ids");
 343     return $U->cstorereq(
 344         "open-ils.cstore.direct.serial.item.search.atomic",
 345         { id => $ids },
 346         { flesh => 2,
 347           flesh_fields => {sitem => [ qw/issuance creator editor stream unit notes/ ], sunit => ["call_number"], siss => [qw/creator editor subscription/]}
 348         });
 349 }
 350
 351
 352 ##########################################################################
 353 # issuance methods
 354 #
 355 __PACKAGE__->register_method(
 356     method    => 'fleshed_issuance_alter',
 357     api_name  => 'open-ils.serial.issuance.fleshed.batch.update',
 358     api_level => 1,
 359     argc      => 2,
 360     signature => {
 361         desc     => 'Receives an array of one or more issuances and updates the database as needed',
 362         'params' => [ {
 363                  name => 'authtoken',
 364                  desc => 'Authtoken for current user session',
 365                  type => 'string'
 366             },
 367             {
 368                  name => 'issuances',
 369                  desc => 'Array of fleshed issuances',
 370                  type => 'array'
 371             }
 372
 373         ],
 374         'return' => {
 375             desc => 'Returns 1 if successful, event if failed',
 376             type => 'mixed'
 377         }
 378     }
 379 );
 380
 381 sub fleshed_issuance_alter {
 382     my( $self, $conn, $auth, $issuances ) = @_;
 383     return 1 unless ref $issuances;
 384     my( $reqr, $evt ) = $U->checkses($auth);
 385     return $evt if $evt;
 386     my $editor = new_editor(requestor => $reqr, xact => 1);
 387     my $override = $self->api_name =~ /override/;
 388
 389     my %found_ssub_ids;
 390     for my $issuance (@$issuances) {
 391         my $ssub_id = ref $issuance->subscription ? $issuance->subscription->id : $issuance->subscription;
 392         if (!exists($found_ssub_ids{$ssub_id})) {
 393             my $owning_lib_id;
 394             if (ref $issuance->subscription) {
 395                 $owning_lib_id = $issuance->subscription->owning_lib;
 396             } else {
 397                 my $ssub = $editor->retrieve_serial_subscription($issuance->subscription) or return $editor->die_event;
 398                 $owning_lib_id = $ssub->owning_lib;
 399             }
 400             return $editor->die_event unless
 401                 $editor->allowed("ADMIN_SERIAL_SUBSCRIPTION", $owning_lib_id);
 402             $found_ssub_ids{$ssub_id} = 1;
 403         }
 404
 405         my $issuanceid = $issuance->id;
 406         $issuance->editor($editor->requestor->id);
 407         $issuance->edit_date('now');
 408
 409         if( $issuance->isdeleted ) {
 410             $evt = _delete_siss( $editor, $override, $issuance);
 411         } elsif( $issuance->isnew ) {
 412             _cleanse_dates($issuance, ['date_published']);
 413             $evt = _create_siss( $editor, $issuance );
 414         } else {
 415             _cleanse_dates($issuance, ['date_published']);
 416             $evt = _update_siss( $editor, $override, $issuance );
 417         }
 418     }
 419
 420     if( $evt ) {
 421         $logger->info("fleshed issuance-alter failed with event: ".OpenSRF::Utils::JSON->perl2JSON($evt));
 422         $editor->rollback;
 423         return $evt;
 424     }
 425     $logger->debug("issuance-alter: done updating issuance batch");
 426     $editor->commit;
 427     $logger->info("fleshed issuance-alter successfully updated ".scalar(@$issuances)." issuances");
 428     return 1;
 429 }
 430
 431 sub _delete_siss {
 432     my ($editor, $override, $issuance) = @_;
 433     $logger->info("issuance-alter: delete issuance ".OpenSRF::Utils::JSON->perl2JSON($issuance));
 434     return $editor->event unless $editor->delete_serial_issuance($issuance);
 435     return 0;
 436 }
 437
 438 sub _create_siss {
 439     my ($editor, $issuance) = @_;
 440
 441     $issuance->creator($editor->requestor->id);
 442     $issuance->create_date('now');
 443
 444     $logger->info("issuance-alter: new issuance ".OpenSRF::Utils::JSON->perl2JSON($issuance));
 445     return $editor->event unless $editor->create_serial_issuance($issuance);
 446     return 0;
 447 }
 448
 449 sub _update_siss {
 450     my ($editor, $override, $issuance) = @_;
 451
 452     $logger->info("issuance-alter: retrieving issuance ".$issuance->id);
 453     my $orig_issuance = $editor->retrieve_serial_issuance($issuance->id);
 454
 455     $logger->info("issuance-alter: original issuance ".OpenSRF::Utils::JSON->perl2JSON($orig_issuance));
 456     $logger->info("issuance-alter: updated issuance ".OpenSRF::Utils::JSON->perl2JSON($issuance));
 457     return $editor->event unless $editor->update_serial_issuance($issuance);
 458     return 0;
 459 }
 460
 461 __PACKAGE__->register_method(
 462     method  => "fleshed_serial_issuance_retrieve_batch",
 463     authoritative => 1,
 464     api_name    => "open-ils.serial.issuance.fleshed.batch.retrieve"
 465 );
 466
 467 sub fleshed_serial_issuance_retrieve_batch {
 468     my( $self, $client, $ids ) = @_;
 469 # FIXME: permissions?
 470     $logger->info("Fetching fleshed serial issuances @$ids");
 471     return $U->cstorereq(
 472         "open-ils.cstore.direct.serial.issuance.search.atomic",
 473         { id => $ids },
 474         { flesh => 1,
 475           flesh_fields => {siss => [ qw/creator editor subscription/ ]}
 476         });
 477 }
 478
 479 __PACKAGE__->register_method(
 480     method  => "pub_fleshed_serial_issuance_retrieve_batch",
 481     api_name    => "open-ils.serial.issuance.pub_fleshed.batch.retrieve",
 482     signature => {
 483         desc => q/
 484             Public (i.e. OPAC) call for getting at the sub and
 485             ultimately the record entry from an issuance
 486         /,
 487         params => [{name => 'ids', desc => 'Array of IDs', type => 'array'}],
 488         return => {
 489             desc => q/
 490                 issuance objects, fleshed with subscriptions
 491             /,
 492             class => 'siss'
 493         }
 494     }
 495 );
 496 sub pub_fleshed_serial_issuance_retrieve_batch {
 497     my( $self, $client, $ids ) = @_;
 498     return [] unless $ids and @$ids;
 499     return new_editor()->search_serial_issuance([
 500         { id => $ids },
 501         {
 502             flesh => 1,
 503             flesh_fields => {siss => [ qw/subscription/ ]}
 504         }
 505     ]);
 506 }
 507
 508 sub received_siss_by_bib {
 509     # XXX this is somewhat wrong in implementation and should not be used in
 510     # new places - senator
 511     my $self = shift;
 512     my $client = shift;
 513     my $bib = shift;
 514
 515     my $args = shift || {};
 516     $$args{order} ||= 'asc';
 517
 518     my $global = $$args{global} == 0 ? 0 : 1;
 519
 520     my $e = new_editor();
 521     my $issuances = $e->json_query({
 522         select  => {
 523             siss => [
 524                 $global ? { transform => "min", column => "id", aggregate => 1 } : "id",
 525                 "label",
 526                 "date_published"
 527             ],
 528             "sitem" => [
 529                 # We're not really interested in the minimum here.  This is
 530                 # just a way to distinguish issuances whose items have units
 531                 # from issuances whose items have no units, without altogether
 532                 # excluding the latter type of issuances.
 533                 {"transform" => "min", "alias" => "has_units",
 534                     "column" => "unit", "aggregate" => 1}
 535             ]
 536         },
 537         from => {
 538             ssub => {
 539                 siss => {
 540                     field => 'subscription',
 541                     fkey  => 'id',
 542                     join  => {
 543                         sitem => {
 544                             field  => 'issuance',
 545                             fkey   => 'id',
 546                             $$args{ou} ? ( join  => {
 547                                 sstr => {
 548                                     field => 'id',
 549                                     fkey  => 'stream',
 550                                     join  => {
 551                                         sdist => {
 552                                             field  => 'id',
 553                                             fkey   => 'distribution'
 554                                         }
 555                                     }
 556                                 }
 557                             }) : ()
 558                         }
 559                     }
 560                 }
 561             }
 562         },
 563         where => {
 564             '+ssub'  => { record_entry => $bib },
 565             $$args{type} ? ( '+siss' => { 'holding_type' => $$args{type} } ) : (),
 566             '+sitem' => {
 567                 # XXX should we also take specific item statuses into account?
 568                 date_received => { '!=' => undef },
 569                 $$args{status} ? ( 'status' => $$args{status} ) : ()
 570             },
 571             $$args{ou} ? ( '+sdist' => {
 572                 holding_lib => {
 573                     'in' => $U->get_org_descendants($$args{ou}, $$args{depth})
 574                 }
 575             }) : ()
 576         },
 577         $$args{limit}  ? ( limit  => $$args{limit}  ) : (),
 578         $$args{offset} ? ( offset => $$args{offset} ) : (),
 579         order_by => [{ class => 'siss', field => 'date_published', direction => $$args{order} }],
 580         distinct => 1
 581     });
 582
 583     $client->respond({
 584         "issuance" => $e->retrieve_serial_issuance($_->{"id"}),
 585         "has_units" => $_->{"has_units"} ? 1 : 0
 586     }) for @$issuances;
 587
 588     return undef;
 589 }
 590 __PACKAGE__->register_method(
 591     method    => 'received_siss_by_bib',
 592     api_name  => 'open-ils.serial.received_siss.retrieve.by_bib',
 593     api_level => 1,
 594     argc      => 1,
 595     stream    => 1,
 596     signature => {
 597         desc   => 'Receives a Bib ID and other optional params and returns "siss" (issuance) objects',
 598         params => [
 599             {   name => 'bibid',
 600                 desc => 'id of the bre to which the issuances belong',
 601                 type => 'number'
 602             },
 603             {   name => 'args',
 604                 desc =>
 605 q/A hash of optional arguments.  Valid keys and their meanings:
 606     global := If true, return only one representative version of a conceptual issuance regardless of the number of subscriptions, otherwise return all issuance objects meeting the requested criteria, including conceptual duplicates. Valid values are 0 (false) and 1 (true, default).
 607     order  := date_published sort direction, either "asc" (chronological, default) or "desc" (reverse chronological)
 608     limit  := Number of issuances to return.  Useful for paging results, or finding the oldest or newest
 609     offset := Number of issuance to skip before returning results.  Useful for paging.
 610     orgid  := OU id used to scope retrieval, based on distribution.holding_lib
 611     depth  := OU depth used to range the scope of orgid
 612     type   := Holding type filter. Valid values are "basic", "supplement" and "index". Can be a scalar (one) or arrayref (one or more).
 613     status := Item status filter. Valid values are "Bindery", "Bound", "Claimed", "Discarded", "Expected", "Not Held", "Not Published" and "Received". Can be a scalar (one) or arrayref (one or more).
 614 /
 615             }
 616         ]
 617     }
 618 );
 619
 620
 621 sub scoped_bib_holdings_summary {
 622     # XXX this is somewhat wrong in implementation and should not be used in
 623     # new places - senator
 624     my $self = shift;
 625     my $client = shift;
 626     my $bibid = shift;
 627     my $args = shift || {};
 628
 629     $args->{order} = 'asc';
 630
 631     my ($issuances) = $self->method_lookup('open-ils.serial.received_siss.retrieve.by_bib.atomic')->run( $bibid => $args );
 632
 633     # split into issuance type sets
 634     my %type_blob = (basic => [], supplement => [], index => []);
 635     push @{ $type_blob{ $_->{"issuance"}->holding_type } }, $_->{"issuance"}
 636         for (@$issuances);
 637
 638     # generate a statement list for each type
 639     my %statement_blob;
 640     for my $type ( keys %type_blob ) {
 641         my ($mfhd,$list) = _summarize_contents(new_editor(), $type_blob{$type});
 642         $statement_blob{$type} = $list;
 643     }
 644
 645     return \%statement_blob;
 646 }
 647 __PACKAGE__->register_method(
 648     method    => 'scoped_bib_holdings_summary',
 649     api_name  => 'open-ils.serial.bib.summary_statements',
 650     api_level => 1,
 651     argc      => 1,
 652     signature => {
 653         desc   => '** DEPRECATED and only used by JSPAC. Somewhat wrong in implementation. *** Receives a Bib ID and other optional params and returns set of holdings statements',
 654         params => [
 655             {   name => 'bibid',
 656                 desc => 'id of the bre to which the issuances belong',
 657                 type => 'number'
 658             },
 659             {   name => 'args',
 660                 desc =>
 661 q/A hash of optional arguments.  Valid keys and their meanings:
 662     orgid  := OU id used to scope retrieval, based on distribution.holding_lib
 663     depth  := OU depth used to range the scope of orgid
 664     type   := Holding type filter. Valid values are "basic", "supplement" and "index". Can be a scalar (one) or arrayref (one or more).
 665     status := Item status filter. Valid values are "Bindery", "Bound", "Claimed", "Discarded", "Expected", "Not Held", "Not Published" and "Received". Can be a scalar (one) or arrayref (one or more).
 666 /
 667             }
 668         ]
 669     }
 670 );
 671
 672
 673 ##########################################################################
 674 # unit methods
 675 #
 676 __PACKAGE__->register_method(
 677     method    => 'fleshed_sunit_alter',
 678     api_name  => 'open-ils.serial.sunit.fleshed.batch.update',
 679     api_level => 1,
 680     argc      => 2,
 681     signature => {
 682         desc     => 'Receives an array of one or more Units and updates the database as needed',
 683         'params' => [ {
 684                  name => 'authtoken',
 685                  desc => 'Authtoken for current user session',
 686                  type => 'string'
 687             },
 688             {
 689                  name => 'sunits',
 690                  desc => 'Array of fleshed Units',
 691                  type => 'array'
 692             }
 693
 694         ],
 695         'return' => {
 696             desc => 'Returns 1 if successful, event if failed',
 697             type => 'mixed'
 698         }
 699     }
 700 );
 701
 702 sub fleshed_sunit_alter {
 703     my( $self, $conn, $auth, $sunits ) = @_;
 704     return 1 unless ref $sunits;
 705     my( $reqr, $evt ) = $U->checkses($auth);
 706     return $evt if $evt;
 707     my $editor = new_editor(requestor => $reqr, xact => 1);
 708     my $override = $self->api_name =~ /override/;
 709
 710     my %found_cn_ids;
 711     for my $sunit (@$sunits) {
 712         my $cn_id = ref $sunit->call_number ? $sunit->call_number->id : $sunit->call_number;
 713         if (!exists($found_cn_ids{$cn_id})) {
 714             my $owning_lib_id;
 715             if (ref $sunit->call_number) {
 716                 $owning_lib_id = $sunit->call_number->owning_lib;
 717             } else {
 718                 my $cn = $editor->retrieve_asset_call_number($sunit->call_number) or return $editor->die_event;
 719                 $owning_lib_id = $cn->owning_lib;
 720             }
 721             return $editor->die_event unless
 722                 $editor->allowed("UPDATE_COPY", $owning_lib_id);
 723             $found_cn_ids{$cn_id} = 1;
 724         }
 725
 726         if( $sunit->isdeleted ) {
 727             $evt = _delete_sunit( $editor, $override, $sunit );
 728         } else {
 729             $sunit->default_location( $sunit->default_location->id ) if ref $sunit->default_location;
 730
 731             if( $sunit->isnew ) {
 732                 $evt = _create_sunit( $editor, $sunit );
 733             } else {
 734                 $evt = _update_sunit( $editor, $override, $sunit );
 735             }
 736         }
 737     }
 738
 739     if( $evt ) {
 740         $logger->info("fleshed sunit-alter failed with event: ".OpenSRF::Utils::JSON->perl2JSON($evt));
 741         $editor->rollback;
 742         return $evt;
 743     }
 744     $logger->debug("sunit-alter: done updating sunit batch");
 745     $editor->commit;
 746     $logger->info("fleshed sunit-alter successfully updated ".scalar(@$sunits)." Units");
 747     return 1;
 748 }
 749
 750 sub _delete_sunit {
 751     my ($editor, $override, $sunit) = @_;
 752     $logger->info("sunit-alter: delete sunit ".OpenSRF::Utils::JSON->perl2JSON($sunit));
 753     return $editor->event unless $editor->delete_serial_unit($sunit);
 754     return 0;
 755 }
 756
 757 sub _create_sunit {
 758     my ($editor, $sunit) = @_;
 759
 760     $logger->info("sunit-alter: new Unit ".OpenSRF::Utils::JSON->perl2JSON($sunit));
 761     return $editor->event unless $editor->create_serial_unit($sunit);
 762     return 0;
 763 }
 764
 765 sub _update_sunit {
 766     my ($editor, $override, $sunit) = @_;
 767
 768     $logger->info("sunit-alter: retrieving sunit ".$sunit->id);
 769     my $orig_sunit = $editor->retrieve_serial_unit($sunit->id);
 770
 771     $logger->info("sunit-alter: original sunit ".OpenSRF::Utils::JSON->perl2JSON($orig_sunit));
 772     $logger->info("sunit-alter: updated sunit ".OpenSRF::Utils::JSON->perl2JSON($sunit));
 773     return $editor->event unless $editor->update_serial_unit($sunit);
 774     return 0;
 775 }
 776
 777 __PACKAGE__->register_method(
 778         method  => "retrieve_unit_list",
 779     authoritative => 1,
 780         api_name        => "open-ils.serial.unit_list.retrieve"
 781 );
 782
 783 sub retrieve_unit_list {
 784
 785         my( $self, $client, @sdist_ids ) = @_;
 786
 787         if(ref($sdist_ids[0])) { @sdist_ids = @{$sdist_ids[0]}; }
 788
 789         my $e = new_editor();
 790
 791     my $query = {
 792         'select' =>
 793             { 'sunit' => [ 'id', 'summary_contents', 'sort_key' ],
 794               'sitem' => ['stream'],
 795               'sstr' => ['distribution'],
 796               'sdist' => [{'column' => 'label', 'alias' => 'sdist_label'}]
 797             },
 798         'from' =>
 799             { 'sdist' =>
 800                 { 'sstr' =>
 801                     { 'join' =>
 802                         { 'sitem' =>
 803                             { 'join' => { 'sunit' => {} } }
 804                         }
 805                     }
 806                 }
 807             },
 808         'distinct' => 'true',
 809         'where' => { '+sdist' => {'id' => \@sdist_ids} },
 810         'order_by' => [{'class' => 'sunit', 'field' => 'sort_key'}]
 811     };
 812
 813     my $unit_list_entries = $e->json_query($query);
 814
 815     my @entries;
 816     foreach my $entry (@$unit_list_entries) {
 817         my $value = {'sunit' => $entry->{id}, 'sstr' => $entry->{stream}, 'sdist' => $entry->{distribution}};
 818         my $label = $entry->{summary_contents};
 819         if (length($label) > 100) {
 820             $label = substr($label, 0, 100) . '...'; # limited space in dropdown / menu
 821         }
 822         $label = "[$entry->{sdist_label}/$entry->{stream} #$entry->{id}] " . $label;
 823         push (@entries, [$label, OpenSRF::Utils::JSON->perl2JSON($value)]);
 824     }
 825
 826     return \@entries;
 827 }
 828
 829
 830
 831 ##########################################################################
 832 # predict and receive methods
 833 #
 834 __PACKAGE__->register_method(
 835     method    => 'make_predictions',
 836     api_name  => 'open-ils.serial.make_predictions',
 837     api_level => 1,
 838     argc      => 1,
 839     signature => {
 840         desc     => 'Receives an ssub id and populates the issuance and item tables',
 841         'params' => [ {
 842                  name => 'ssub_id',
 843                  desc => 'Serial Subscription ID',
 844                  type => 'int'
 845             }
 846         ]
 847     }
 848 );
 849
 850 sub make_predictions {
 851     my ($self, $conn, $authtoken, $args) = @_;
 852
 853     my $editor = OpenILS::Utils::CStoreEditor->new();
 854     my $ssub_id = $args->{ssub_id};
 855     my $mfhd = MFHD->new(MARC::Record->new());
 856
 857     my $ssub = $editor->retrieve_serial_subscription([$ssub_id]);
 858     my $scaps = $editor->search_serial_caption_and_pattern({ subscription => $ssub_id, active => 't'});
 859     my $sdists = $editor->search_serial_distribution( [{ subscription => $ssub->id }, { flesh => 1, flesh_fields => {sdist => [ qw/ streams / ]} }] ); #TODO: 'deleted' support?
 860
 861     my $total_streams = 0;
 862     foreach (@$sdists) {
 863         $total_streams += scalar(@{$_->streams});
 864     }
 865     if ($total_streams < 1) {
 866         $editor->disconnect;
 867         # XXX TODO new event type
 868         return new OpenILS::Event(
 869             "BAD_PARAMS", note =>
 870                 "There are no streams to direct items. Can't predict."
 871         );
 872     }
 873
 874     unless (@$scaps) {
 875         $editor->disconnect;
 876         # XXX TODO new event type
 877         return new OpenILS::Event(
 878             "BAD_PARAMS", note =>
 879                 "There are no active caption-and-pattern objects associated " .
 880                 "with this subscription. Can't predict."
 881         );
 882     }
 883
 884     my @predictions;
 885     my $link_id = 1;
 886     foreach my $scap (@$scaps) {
 887         my $caption_field = _revive_caption($scap);
 888         $caption_field->update('8' => $link_id);
 889         my $fake_chron_needed = 0;
 890         # if we have missing chron pieces, we will add them later for prediction purposes
 891         if (!$caption_field->enumeration_is_chronology) {
 892             if (!$caption_field->subfield('i') # no year
 893                 or !$caption_field->subfield('j')) { # we had a year, but no month or season
 894                 $fake_chron_needed = '1';
 895             }
 896         }
 897         $mfhd->append_fields($caption_field);
 898         my $options = {
 899                 'caption' => $caption_field,
 900                 'scap_id' => $scap->id,
 901                 'num_to_predict' => $args->{num_to_predict},
 902                 'end_date' => defined $args->{end_date} ?
 903                     $_strp_date->parse_datetime($args->{end_date}) : undef
 904                 };
 905         my $predict_from_siss;
 906         if ($args->{base_issuance}) { # predict from a given issuance
 907             $predict_from_siss = $args->{base_issuance}->holding_code;
 908         } else { # default to predicting from last published
 909             my $last_published = $editor->search_serial_issuance([
 910                     {'caption_and_pattern' => $scap->id,
 911                     'subscription' => $ssub_id},
 912                 {limit => 1, order_by => { siss => "date_published DESC" }}]
 913                 );
 914             if ($last_published->[0]) {
 915                 $predict_from_siss = $last_published->[0];
 916                 unless ($predict_from_siss->holding_code) {
 917                     $editor->disconnect;
 918                     # XXX TODO new event type
 919                     return new OpenILS::Event(
 920                         "BAD_PARAMS", note =>
 921                             "Last issuance has no holding code. Can't predict."
 922                     );
 923                 }
 924             } else {
 925                 $editor->disconnect;
 926                 # XXX TODO make a new event type instead of hijacking this one
 927                 return new OpenILS::Event(
 928                     "BAD_PARAMS", note => "No issuance from which to predict!"
 929                 );
 930             }
 931         }
 932         $options->{predict_from} = _revive_holding($predict_from_siss->holding_code, $caption_field, 1); # fresh MFHD Record, so we simply default to 1 for seqno
 933         if ($fake_chron_needed) {
 934             $options->{faked_chron_date} = DateTime::Format::ISO8601->new->parse_datetime(cleanse_ISO8601($predict_from_siss->date_published));
 935         }
 936         push( @predictions, _generate_issuance_values($mfhd, $options) );
 937         $link_id++;
 938     }
 939
 940     my @issuances;
 941     foreach my $prediction (@predictions) {
 942         my $issuance = new Fieldmapper::serial::issuance;
 943         $issuance->isnew(1);
 944         $issuance->label($prediction->{label});
 945         $issuance->date_published($prediction->{date_published}->strftime('%F'));
 946         $issuance->holding_code(OpenSRF::Utils::JSON->perl2JSON($prediction->{holding_code}));
 947         $issuance->holding_type($prediction->{holding_type});
 948         $issuance->caption_and_pattern($prediction->{caption_and_pattern});
 949         $issuance->subscription($ssub->id);
 950         push (@issuances, $issuance);
 951     }
 952
 953     my $evt = fleshed_issuance_alter($self, $conn, $authtoken, \@issuances);
 954     return $evt if ref $evt;
 955
 956     my @items;
 957     for (my $i = 0; $i < @issuances; $i++) {
 958         my $date_expected = $predictions[$i]->{date_published}->add(seconds => interval_to_seconds($ssub->expected_date_offset))->strftime('%F');
 959         my $issuance = $issuances[$i];
 960         #$issuance->label(interval_to_seconds($ssub->expected_date_offset));
 961         foreach my $sdist (@$sdists) {
 962             my $streams = $sdist->streams;
 963             foreach my $stream (@$streams) {
 964                 my $item = new Fieldmapper::serial::item;
 965                 $item->isnew(1);
 966                 $item->stream($stream->id);
 967                 $item->date_expected($date_expected);
 968                 $item->issuance($issuance->id);
 969                 push (@items, $item);
 970             }
 971         }
 972     }
 973     fleshed_item_alter($self, $conn, $authtoken, \@items); # FIXME: catch events
 974     return \@items;
 975 }
 976
 977 #
 978 # _generate_issuance_values() is an initial attempt at a function which can be used
 979 # to populate an issuance table with a list of predicted issues.  It accepts
 980 # a hash ref of options initially defined as:
 981 # caption : the caption field to predict on
 982 # num_to_predict : the number of issues you wish to predict
 983 # faked_chron_date : if the serial does not actually have a chronology caption (but we need one for prediction's sake), base predictions on this date
 984 #
 985 # The basic method is to first convert to a single holding if compressed, then
 986 # increment the holding and save the resulting values to @issuances.
 987 #
 988 # returns @issuance_values, an array of hashrefs containing (formatted
 989 # label, formatted chronology date, formatted estimated arrival date, and an
 990 # array ref of holding subfields as (key, value, key, value ...)) (not a hash
 991 # to protect order and possible duplicate keys), and a holding type.
 992 #
 993 sub _generate_issuance_values {
 994     my ($mfhd, $options) = @_;
 995     my $caption = $options->{caption};
 996     my $scap_id = $options->{scap_id};
 997     my $num_to_predict = $options->{num_to_predict};
 998     my $end_date = $options->{end_date};
 999     my $predict_from = $options->{predict_from};   # MFHD::Holding to predict from
1000     my $faked_chron_date = $options->{faked_chron_date};   # serial does not have a (complete) chronology caption, so add one (temporarily) based on this date
1001
1002
1003 # Only needed for 'real' MFHD records, not our temp records
1004 #    my $link_id = $caption->link_id;
1005 #    if(!$predict_from) {
1006 #        my $htag = $caption->tag;
1007 #        $htag =~ s/^85/86/;
1008 #        my @holdings = $mfhd->holdings($htag, $link_id);
1009 #        my $last_holding = $holdings[-1];
1010 #
1011 #        #if ($last_holding->is_compressed) {
1012 #        #    $last_holding->compressed_to_last; # convert to last in range
1013 #        #}
1014 #        $predict_from = $last_holding;
1015 #    }
1016 #
1017
1018     $predict_from->notes('public',  []);
1019 # add a note marker for system use (?)
1020     $predict_from->notes('private', ['AUTOGEN']);
1021
1022     # our basic method for dealing with 'faked' chronologies will be to add it in, do the predicting, then take it back out
1023     my @faked_subfield_chars;
1024     if ($faked_chron_date) {
1025         my $faked_caption = new MARC::Field($caption->tag, $caption->indicator(1), $caption->indicator(2), $caption->subfields_list);
1026
1027         my %mfhd_chron_labels = ('i' => 'year', 'j' => 'month', 'k' => 'day');
1028         foreach my $subfield_char ('i', 'j', 'k') {
1029             if (!$caption->subfield($subfield_char)) { # if we are missing a piece, add it
1030                 push(@faked_subfield_chars, $subfield_char);
1031                 my $chron_name = $mfhd_chron_labels{$subfield_char};
1032                 $faked_caption->add_subfields($subfield_char => "($chron_name)");
1033                 my $method = $mfhd_chron_labels{$subfield_char};
1034                 $predict_from->add_subfields($subfield_char => $faked_chron_date->$chron_name);
1035             }
1036         }
1037         # because of the way MFHD::Caption and Holding work, it is simplest
1038         # to recreate rather than try to update
1039         $faked_caption = new MFHD::Caption($faked_caption);
1040         $predict_from = new MFHD::Holding($predict_from->seqno, new MARC::Field($predict_from->tag, $predict_from->indicator(1), $predict_from->indicator(2), $predict_from->subfields_list), $faked_caption);
1041     }
1042
1043     my @predictions = $mfhd->generate_predictions({'base_holding' => $predict_from, 'num_to_predict' => $num_to_predict, 'end_date' => $end_date});
1044
1045     my $pub_date;
1046     my @issuance_values;
1047     foreach my $prediction (@predictions) {
1048         $pub_date = $_strp_date->parse_datetime($prediction->chron_to_date);
1049         if ($faked_chron_date) { # get rid of the chronology portions and restore original caption
1050             $prediction->delete_subfield(code => \@faked_subfield_chars);
1051             $prediction = new MFHD::Holding($prediction->seqno, new MARC::Field($prediction->tag, $prediction->indicator(1), $prediction->indicator(2), $prediction->subfields_list), $caption);
1052         }
1053         push(
1054                 @issuance_values,
1055                 {
1056                     #$link_id,
1057                     label => $prediction->format,
1058                     date_published => $pub_date,
1059                     #date_expected => $date_expected->strftime('%F'),
1060                     holding_code => [$prediction->indicator(1),$prediction->indicator(2),$prediction->subfields_list],
1061                     holding_type => $MFHD_NAMES_BY_TAG{$caption->tag},
1062                     caption_and_pattern => $scap_id
1063                 }
1064             );
1065     }
1066
1067     return @issuance_values;
1068 }
1069
1070 sub _revive_caption {
1071     my $scap = shift;
1072
1073     my $pattern_code = $scap->pattern_code;
1074
1075     # build MARC::Field
1076     my $pattern_parts = OpenSRF::Utils::JSON->JSON2perl($pattern_code);
1077     unshift(@$pattern_parts, $MFHD_TAGS_BY_NAME{$scap->type});
1078     my $pattern_field = new MARC::Field(@$pattern_parts);
1079
1080     # build MFHD::Caption
1081     return new MFHD::Caption($pattern_field);
1082 }
1083
1084 sub _revive_holding {
1085     my $holding_code = shift;
1086     my $caption_field = shift;
1087     my $seqno = shift;
1088
1089     # build MARC::Field
1090     my $holding_parts = OpenSRF::Utils::JSON->JSON2perl($holding_code);
1091     my $captag = $caption_field->tag;
1092     $captag =~ s/^85/86/;
1093     unshift(@$holding_parts, $captag);
1094     my $holding_field = new MARC::Field(@$holding_parts);
1095
1096     # build MFHD::Holding
1097     return new MFHD::Holding($seqno, $holding_field, $caption_field);
1098
1099     # TODO(?) the underlying MARC and the Holding object end up in conflict concerning subfield '8'
1100 }
1101
1102 __PACKAGE__->register_method(
1103     method    => 'unitize_items',
1104     api_name  => 'open-ils.serial.receive_items',
1105     api_level => 1,
1106     argc      => 1,
1107     signature => {
1108         desc     => 'Marks an item as received, updates the shelving unit (creating a new shelving unit if needed), and updates the summaries',
1109         'params' => [ {
1110                  name => 'items',
1111                  desc => 'array of serial items',
1112                  type => 'array'
1113             },
1114             {
1115                  name => 'barcodes',
1116                  desc => 'hash of item_ids => barcodes',
1117                  type => 'hash'
1118             },
1119             {
1120                  name => 'call_numbers',
1121                  desc => 'hash of item_ids => call_numbers',
1122                  type => 'hash'
1123             },
1124             {
1125                  name => 'donor_unit_ids',
1126                  desc => 'hash of unit_ids => 1, keyed with ids of any units giving up items',
1127                  type => 'hash'
1128             }
1129         ],
1130         'return' => {
1131             desc => 'Returns number of received items (num_items) and new unit ID, if applicable (new_unit_id)',
1132             type => 'hashref'
1133         }
1134     }
1135 );
1136
1137 __PACKAGE__->register_method(
1138     method    => 'unitize_items',
1139     api_name  => 'open-ils.serial.bind_items',
1140     api_level => 1,
1141     argc      => 1,
1142     signature => {
1143         desc     => 'Marks an item as bound, updates the shelving unit (creating a new shelving unit if needed)',
1144         'params' => [ {
1145                  name => 'items',
1146                  desc => 'array of serial items',
1147                  type => 'array'
1148             },
1149             {
1150                  name => 'barcodes',
1151                  desc => 'hash of item_ids => barcodes',
1152                  type => 'hash'
1153             },
1154             {
1155                  name => 'call_numbers',
1156                  desc => 'hash of item_ids => call_numbers',
1157                  type => 'hash'
1158             },
1159             {
1160                  name => 'donor_unit_ids',
1161                  desc => 'hash of unit_ids => 1, keyed with ids of any units giving up items',
1162                  type => 'hash'
1163             }
1164         ],
1165         'return' => {
1166             desc => 'Returns number of bound items (num_items) and new unit ID, if applicable (new_unit_id)',
1167             type => 'hashref'
1168         }
1169     }
1170 );
1171
1172 # TODO: reset/delete claims information once implemented
1173 # XXX: deal with emptied call numbers here?
1174 __PACKAGE__->register_method(
1175     method    => 'unitize_items',
1176     api_name  => 'open-ils.serial.reset_items',
1177     api_level => 1,
1178     argc      => 1,
1179     signature => {
1180         desc     => 'Resets the items to Expected, updates the shelving unit (deleting the shelving unit if empty), and updates the summaries',
1181         'params' => [ {
1182                  name => 'items',
1183                  desc => 'array of serial items',
1184                  type => 'array'
1185             }
1186         ],
1187         'return' => {
1188             desc => 'Returns number of reset items (num_items)',
1189             type => 'hashref'
1190         }
1191     }
1192 );
1193
1194 sub unitize_items {
1195     my ($self, $conn, $auth, $items, $barcodes, $call_numbers, $donor_unit_ids) = @_;
1196
1197     my $editor = new_editor("authtoken" => $auth, "xact" => 1);
1198     return $editor->die_event unless $editor->checkauth;
1199     return $editor->die_event unless $editor->allowed("RECEIVE_SERIAL");
1200     $self->api_name =~ /serial\.(\w*)_items/;
1201     my $mode = $1;
1202
1203     my %found_unit_ids;
1204     if ($donor_unit_ids) { # units giving up items need updating as well
1205         %found_unit_ids = %$donor_unit_ids;
1206     }
1207     my %found_stream_ids;
1208     my %found_types;
1209
1210     my %stream_ids_by_unit_id;
1211
1212     my %unit_map;
1213     my %sdist_by_unit_id;
1214     my %call_number_by_unit_id;
1215     my %sdist_by_stream_id;
1216
1217     my $new_unit_id; # id for '-2' units to share
1218     foreach my $item (@$items) {
1219         # for debugging only, TODO: delete
1220         if (!ref $item) { # hopefully we got an id instead
1221             $item = $editor->retrieve_serial_item($item);
1222         }
1223         # get ids
1224         my $unit_id = ref($item->unit) ? $item->unit->id : $item->unit;
1225         my $stream_id = ref($item->stream) ? $item->stream->id : $item->stream;
1226         my $issuance_id = ref($item->issuance) ? $item->issuance->id : $item->issuance;
1227         #TODO: evt on any missing ids
1228
1229         if ($mode eq 'receive') {
1230             $item->date_received('now');
1231             $item->status('Received');
1232         } elsif ($mode eq 'reset') {
1233             # clear date_received
1234             $item->clear_date_received;
1235             # Set status to 'Expected'
1236             $item->status('Expected');
1237             # remove from unit
1238             $item->clear_unit;
1239         }
1240
1241         # check for types to trigger summary updates
1242         my $scap;
1243         if (!ref $item->issuance) {
1244             my $scaps = $editor->search_serial_caption_and_pattern([{"+siss" => {"id" => $issuance_id}}, { "join" => {"siss" => {}} }]);
1245             $scap = $scaps->[0];
1246         } elsif (!ref $item->issuance->caption_and_pattern) {
1247             $scap = $editor->retrieve_serial_caption_and_pattern($item->issuance->caption_and_pattern);
1248         } else {
1249             $scap = $editor->issuance->caption_and_pattern;
1250         }
1251         if (!exists($found_types{$stream_id})) {
1252             $found_types{$stream_id} = {};
1253         }
1254         $found_types{$stream_id}->{$scap->type} = 1;
1255
1256         # create unit if needed
1257         if ($unit_id == -1 or (!$new_unit_id and $unit_id == -2)) { # create unit per item
1258             my $unit;
1259             my $sdists = $editor->search_serial_distribution([
1260                 {"+sstr" => {"id" => $stream_id}},
1261                 {
1262                     "join" => {"sstr" => {}},
1263                     "flesh" => 1,
1264                     "flesh_fields" => {"sdist" => ["subscription"]}
1265                 }]);
1266             $unit = _build_unit($editor, $sdists->[0], $mode);
1267             # if _build_unit fails, $unit is an event, so return it
1268             if ($U->event_code($unit)) {
1269                 $editor->rollback;
1270                 $unit->{"note"} = "Item ID: " . $item->id;
1271                 return $unit;
1272             }
1273             $unit->barcode($barcodes->{$item->id}) if exists($barcodes->{$item->id});
1274             my $evt =  _create_sunit($editor, $unit);
1275             return $evt if $evt;
1276             if ($unit_id == -2) {
1277                 $new_unit_id = $unit->id;
1278                 $unit_id = $new_unit_id;
1279             } else {
1280                 $unit_id = $unit->id;
1281             }
1282             $item->unit($unit_id);
1283
1284             # get unit with 'DEFAULT's and save unit, sdist, and call number for later use
1285             $unit = $editor->retrieve_serial_unit($unit->id);
1286             $unit_map{$unit_id} = $unit;
1287             $sdist_by_unit_id{$unit_id} = $sdists->[0];
1288             $call_number_by_unit_id{$unit_id} = $call_numbers->{$item->id};
1289             $sdist_by_stream_id{$stream_id} = $sdists->[0];
1290         } elsif ($unit_id == -2) { # create one unit for all '-2' items
1291             $unit_id = $new_unit_id;
1292             $item->unit($unit_id);
1293         }
1294
1295         $found_stream_ids{$stream_id} = 1;
1296
1297         if (defined($unit_id) and $unit_id ne '') {
1298             $found_unit_ids{$unit_id} = 1;
1299             # save the stream_id for this unit_id
1300             # TODO: prevent items from different streams in same unit? (perhaps in interface)
1301             $stream_ids_by_unit_id{$unit_id} = $stream_id;
1302         } else {
1303             $item->clear_unit;
1304         }
1305
1306         my $evt = _update_sitem($editor, undef, $item);
1307         return $evt if $evt;
1308     }
1309
1310     # cleanup 'dead' units (units which are now emptied of their items)
1311     my $dead_units = $editor->search_serial_unit([{'+sitem' => {'id' => undef}, 'deleted' => 'f'}, {'join' => {'sitem' => {'type' => 'left'}}}]);
1312     foreach my $unit (@$dead_units) {
1313         _delete_sunit($editor, undef, $unit);
1314         delete $found_unit_ids{$unit->id};
1315     }
1316
1317     # deal with unit level contents
1318     foreach my $unit_id (keys %found_unit_ids) {
1319
1320         # get all the needed issuances for unit
1321         # TODO remove 'Bindery' from this search (leaving it in for now for backwards compatibility with any current test environment data)
1322         my $issuances = $editor->search_serial_issuance([ {"+sitem" => {"unit" => $unit_id, "status" => ["Received", "Bindery"]}}, {"join" => {"sitem" => {}}, "order_by" => {"siss" => "date_published"}} ]);
1323         #TODO: evt on search failure
1324
1325         # retrieve and update unit contents
1326         my $sunit;
1327         my $sdist;
1328         my $call_number_string;
1329         my $record_id;
1330         # if we just created the unit, we will already have it and the distribution stored, and we will need to assign the call number
1331         if (exists $unit_map{$unit_id}) {
1332             $sunit = $unit_map{$unit_id};
1333             $sdist = $sdist_by_unit_id{$unit_id};
1334             $call_number_string = $call_number_by_unit_id{$unit_id};
1335             $record_id = $sdist->subscription->record_entry;
1336         } else {
1337             # XXX: this code assumes you will not have units which mix streams/distributions, but current code does not enforce this
1338             $sunit = $editor->retrieve_serial_unit($unit_id);
1339             if ($stream_ids_by_unit_id{$unit_id}) {
1340                 $sdist = $editor->search_serial_distribution([{"+sstr" => {"id" => $stream_ids_by_unit_id{$unit_id}}}, { "join" => {"sstr" => {}}, 'limit' => 1 }]);
1341             } else {
1342                 $sdist = $editor->search_serial_distribution([
1343                     {'+sunit' => {'id' => $unit_id}},
1344                     { 'join' =>
1345                         {'sstr' =>
1346                             { 'join' =>
1347                                 { 'sitem' =>
1348                                     { 'join' => 'sunit' }
1349                                 }
1350                             }
1351                         },
1352                       'limit' => 1
1353                     }]);
1354             }
1355             $sdist = $sdist->[0];
1356         }
1357
1358         my $evt = _prepare_unit($editor, $sunit, $sdist, $issuances, $call_number_string, $record_id);
1359         if ($U->event_code($evt)) {
1360             $editor->rollback;
1361             return $evt;
1362         }
1363
1364         $evt = _update_sunit($editor, undef, $sunit);
1365         if ($U->event_code($evt)) {
1366             $editor->rollback;
1367             return $evt;
1368         }
1369     }
1370
1371     if ($mode ne 'bind') { # the summary holdings do not change when binding
1372         # deal with stream level summaries
1373         # summaries will be built from the "primary" stream only, that is, the stream with the lowest ID per distribution
1374         # (TODO: consider direct designation)
1375         my %primary_streams_by_sdist;
1376         my %streams_by_sdist;
1377
1378         # see if we have primary streams, and if so, associate them with their distributions
1379         foreach my $stream_id (keys %found_stream_ids) {
1380             my $sdist;
1381             if (exists $sdist_by_stream_id{$stream_id}) {
1382                 $sdist = $sdist_by_stream_id{$stream_id};
1383             } else {
1384                 $sdist = $editor->search_serial_distribution([{"+sstr" => {"id" => $stream_id}}, { "join" => {"sstr" => {}} }]);
1385                 $sdist = $sdist->[0];
1386                 $sdist_by_stream_id{$stream_id} = $sdist;
1387             }
1388             my $streams;
1389             if (!exists($streams_by_sdist{$sdist->id})) {
1390                 $streams = $editor->search_serial_stream([{"distribution" => $sdist->id}, {"order_by" => {"sstr" => "id"}}]);
1391                 $streams_by_sdist{$sdist->id} = $streams;
1392             } else {
1393                 $streams = $streams_by_sdist{$sdist->id};
1394             }
1395             $primary_streams_by_sdist{$sdist->id} = $streams->[0] if ($stream_id == $streams->[0]->id);
1396         }
1397
1398         # retrieve and update summaries for each affected primary stream's distribution
1399         foreach my $sdist_id (keys %primary_streams_by_sdist) {
1400             my $stream = $primary_streams_by_sdist{$sdist_id};
1401             my $stream_id = $stream->id;
1402             # get all the needed issuances for stream
1403             # FIXME: search in Bindery/Bound/Not Published? as well as Received
1404             foreach my $type (keys %{$found_types{$stream_id}}) {
1405                 my $issuances = $editor->search_serial_issuance([ {"+sitem" => {"stream" => $stream_id, "status" => "Received"}, "+scap" => {"type" => $type}}, {"join" => {"sitem" => {}, "scap" => {}}, "order_by" => {"siss" => "date_published"}} ]);
1406                 #TODO: evt on search failure
1407                 my $evt = _prepare_summaries($editor, $issuances, $sdist_by_stream_id{$stream_id}, $type);
1408                 if ($U->event_code($evt)) {
1409                     $editor->rollback;
1410                     return $evt;
1411                 }
1412             }
1413         }
1414     }
1415
1416     $editor->commit;
1417     return {'num_items' => scalar @$items, 'new_unit_id' => $new_unit_id};
1418 }
1419
1420 sub _find_or_create_call_number {
1421     my ($e, $lib, $cn_string, $record) = @_;
1422
1423     # FIXME: should suffix and prefix come into play here?
1424     my $existing = $e->search_asset_call_number({
1425         "owning_lib" => $lib,
1426         "label" => $cn_string,
1427         "record" => $record,
1428         "deleted" => "f"
1429     }) or return $e->die_event;
1430
1431     if (@$existing) {
1432         return $existing->[0]->id;
1433     } else {
1434         return $e->die_event unless
1435             $e->allowed("CREATE_VOLUME", $lib);
1436
1437         my $acn = new Fieldmapper::asset::call_number;
1438
1439         $acn->creator($e->requestor->id);
1440         $acn->editor($e->requestor->id);
1441         $acn->record($record);
1442         $acn->label($cn_string);
1443         $acn->owning_lib($lib);
1444
1445         $e->create_asset_call_number($acn) or return $e->die_event;
1446         return $e->data->id;
1447     }
1448 }
1449
1450 sub _issuances_received {
1451     # XXX TODO: Add some caching or something. This is getting called
1452     # more often than it has to be.
1453     my ($e, $sitem) = @_;
1454
1455     my $results = $e->json_query({
1456         "select" => {"sitem" => ["issuance"]},
1457         "from" => {"sitem" => {"sstr" => {}, "siss" => {}}},
1458         "where" => {
1459             "+sstr" => {"distribution" => $sitem->stream->distribution->id},
1460             "+siss" => {"holding_type" => $sitem->issuance->holding_type},
1461             "+sitem" => {"date_received" => {"!=" => undef}}
1462         },
1463         "order_by" => {
1464             "siss" => {"date_published" => {"direction" => "asc"}}
1465         }
1466     }) or return $e->die_event;
1467
1468     my $uniq = +{map { $_->{"issuance"} => 1 } @$results};
1469     return [ map { $e->retrieve_serial_issuance($_) } keys %$uniq ];
1470 }
1471
1472 # _prepare_unit populates the detailed_contents, summary_contents, and
1473 # sort_key fields for a given unit based on a given set of issuances
1474 # Also finds/creates call number as needed
1475 sub _prepare_unit {
1476     my ($e, $sunit, $sdist, $issuances, $call_number_string, $record_id) = @_;
1477
1478     # Handle call number first if we have one
1479     if ($call_number_string) {
1480         my $org_unit_id = ref $sdist->holding_lib ? $sdist->holding_lib->id : $sdist->holding_lib;
1481         my $real_cn = _find_or_create_call_number(
1482             $e, $org_unit_id,
1483             $call_number_string, $record_id
1484         );
1485
1486         if ($U->event_code($real_cn)) {
1487             return $real_cn;
1488         } else {
1489             $sunit->call_number($real_cn);
1490         }
1491     }
1492
1493     my ($mfhd, $formatted_parts) = _summarize_contents($e, $issuances);
1494
1495     # special case for single formatted_part (may have summarized version)
1496     if (@$formatted_parts == 1) {
1497         #TODO: MFHD.pm should have a 'format_summary' method for this
1498     }
1499
1500     $sunit->detailed_contents(
1501         join(
1502             " ",
1503             $sdist->unit_label_prefix,
1504             join(", ", @$formatted_parts),
1505             $sdist->unit_label_suffix
1506         )
1507     );
1508
1509     # TODO: change this when real summary contents are available
1510     $sunit->summary_contents($sunit->detailed_contents);
1511
1512     # Create sort_key by left padding numbers to 6 digits.
1513     (my $sort_key = $sunit->detailed_contents) =~
1514         s/(\d+)/sprintf '%06d', $1/eg;
1515     $sunit->sort_key($sort_key);
1516 }
1517
1518 # _prepare_summaries populates the generated_coverage field for a given summary
1519 # type ('basic', 'index', 'supplement') for a given distribution.
1520 # It also creates the summary if it doesn't yet exist.
1521 sub _prepare_summaries {
1522     my ($e, $issuances, $sdist, $type) = @_;
1523
1524     my ($mfhd, $formatted_parts) = _summarize_contents($e, $issuances, $sdist);
1525
1526     my $search_method = "search_serial_${type}_summary";
1527     my $summary = $e->$search_method([{"distribution" => $sdist->id}]);
1528
1529     my $cu_method = "update";
1530
1531     if (@$summary) {
1532         $summary = $summary->[0];
1533     } else {
1534         my $class = "Fieldmapper::serial::${type}_summary";
1535         $summary = $class->new;
1536         $summary->distribution($sdist->id);
1537         $cu_method = "create";
1538     }
1539
1540     $summary->generated_coverage(OpenSRF::Utils::JSON->perl2JSON($formatted_parts));
1541     my $method = "${cu_method}_serial_${type}_summary";
1542     return $e->die_event unless $e->$method($summary);
1543 }
1544
1545 sub _unit_by_iss_and_str {
1546     my ($e, $issuance, $stream) = @_;
1547
1548     my $unit = $e->json_query({
1549         "select" => {"sunit" => ["id"]},
1550         "from" => {"sitem" => {"sunit" => {}}},
1551         "where" => {
1552             "+sitem" => {
1553                 "issuance" => $issuance->id,
1554                 "stream" => $stream->id
1555             }
1556         }
1557     }) or return $e->die_event;
1558     return 0 if not @$unit;
1559
1560     $e->retrieve_serial_unit($unit->[0]->{"id"}) or $e->die_event;
1561 }
1562
1563 sub move_previous_unit {
1564     my ($e, $prev_iss, $curr_item, $new_loc) = @_;
1565
1566     my $prev_unit = _unit_by_iss_and_str($e,$prev_iss,$curr_item->stream);
1567     return $prev_unit if defined $U->event_code($prev_unit);
1568     return 0 if not $prev_unit;
1569
1570     if ($prev_unit->location != $new_loc) {
1571         $prev_unit->location($new_loc);
1572         $e->update_serial_unit($prev_unit) or return $e->die_event;
1573     }
1574     0;
1575 }
1576
1577 # _previous_issuance() assumes $existing is an ordered array
1578 sub _previous_issuance {
1579     my ($existing, $issuance) = @_;
1580
1581     my $last = $existing->[-1];
1582     return undef unless $last;
1583     return ($last->id == $issuance->id ? $existing->[-2] : $last);
1584 }
1585
1586 __PACKAGE__->register_method(
1587     "method" => "receive_items_one_unit_per",
1588     "api_name" => "open-ils.serial.receive_items.one_unit_per",
1589     "stream" => 1,
1590     "api_level" => 1,
1591     "argc" => 3,
1592     "signature" => {
1593         "desc" => "Marks items in a list as received, creates a new unit for each item if any unit is fleshed on, and updates summaries as needed",
1594         "params" => [
1595             {
1596                  "name" => "auth",
1597                  "desc" => "authtoken",
1598                  "type" => "string"
1599             },
1600             {
1601                  "name" => "items",
1602                  "desc" => "array of serial items, possibly fleshed with units and definitely fleshed with stream->distribution",
1603                  "type" => "array"
1604             },
1605             {
1606                 "name" => "record",
1607                 "desc" => "id of bib record these items are associated with
1608                     (XXX could/should be derived from items)",
1609                 "type" => "number"
1610             }
1611         ],
1612         "return" => {
1613             "desc" => "The item ID for each item successfully received",
1614             "type" => "int"
1615         }
1616     }
1617 );
1618
1619 sub receive_items_one_unit_per {
1620     # XXX This function may be temporary, as it does some of what
1621     # unitize_items() does, just in a different way.
1622     my ($self, $client, $auth, $items, $record) = @_;
1623
1624     my $e = new_editor("authtoken" => $auth, "xact" => 1);
1625     return $e->die_event unless $e->checkauth;
1626     return $e->die_event unless $e->allowed("RECEIVE_SERIAL");
1627
1628     my $prev_loc_setting_map = {};
1629     my $user_id = $e->requestor->id;
1630
1631     # Get a list of all the non-virtual field names in a serial::unit for
1632     # merging given unit objects with template-built units later.
1633     # XXX move this somewhere global so it isn't re-run all the time
1634     my $all_unit_fields =
1635         $Fieldmapper::fieldmap->{"Fieldmapper::serial::unit"}->{"fields"};
1636     my @real_unit_fields = grep {
1637         not $all_unit_fields->{$_}->{"virtual"}
1638     } keys %$all_unit_fields;
1639
1640     foreach my $item (@$items) {
1641         # Note that we expect a certain fleshing on the items we're getting.
1642         my $sdist = $item->stream->distribution;
1643
1644         # Fetch a list of issuances with received copies already existing
1645         # on this distribution (and with the same holding type on the
1646         # issuance).  This will be used in up to two places: once when building
1647         # a summary, once when changing the copy location of the previous
1648         # issuance's copy.
1649         my $issuances_received = _issuances_received($e, $item);
1650         if ($U->event_code($issuances_received)) {
1651             $e->rollback;
1652             return $issuances_received;
1653         }
1654
1655         # Find out if we need to to deal with previous copy location changing.
1656         my $ou = $sdist->holding_lib->id;
1657         unless (exists $prev_loc_setting_map->{$ou}) {
1658             $prev_loc_setting_map->{$ou} = $U->ou_ancestor_setting_value(
1659                 $ou, "serial.prev_issuance_copy_location", $e
1660             );
1661         }
1662
1663         # If there is a previous copy location setting, we need the previous
1664         # issuance, from which we can in turn look up the item attached to the
1665         # same stream we're on now.
1666         if ($prev_loc_setting_map->{$ou}) {
1667             if (my $prev_iss =
1668                 _previous_issuance($issuances_received, $item->issuance)) {
1669
1670                 # Now we can change the copy location of the previous unit,
1671                 # if needed.
1672                 return $e->event if defined $U->event_code(
1673                     move_previous_unit(
1674                         $e, $prev_iss, $item, $prev_loc_setting_map->{$ou}
1675                     )
1676                 );
1677             }
1678         }
1679
1680         # Create unit if given by user
1681         if (ref $item->unit) {
1682             # detach from the item, as we need to create separately
1683             my $user_unit = $item->unit;
1684
1685             # get a unit based on associated template
1686             my $template_unit = _build_unit($e, $sdist, "receive");
1687             if ($U->event_code($template_unit)) {
1688                 $e->rollback;
1689                 $template_unit->{"note"} = "Item ID: " . $item->id;
1690                 return $template_unit;
1691             }
1692
1693             # merge built unit with provided unit from user
1694             foreach (@real_unit_fields) {
1695                 unless ($user_unit->$_) {
1696                     $user_unit->$_($template_unit->$_);
1697                 }
1698             }
1699
1700             # Treat call number specially: the provided value from the
1701             # user will really be a string.
1702             my $call_number_string;
1703             if ($user_unit->call_number) {
1704                 $call_number_string = $user_unit->call_number;
1705                 # clear call number for now (replaced in _prepare_unit)
1706                 $user_unit->clear_call_number;
1707             }
1708
1709             my $evt = _prepare_unit(
1710                 $e, $user_unit, $sdist, [$item->issuance],
1711                 $call_number_string, $record
1712             );
1713             if ($U->event_code($evt)) {
1714                 $e->rollback;
1715                 return $evt;
1716             }
1717
1718             # create/update summary objects related to this distribution
1719             # Make sure @$issuances_received contains current item's issuance
1720             unless (grep { $_->id == $item->issuance->id } @$issuances_received) {
1721                 push @$issuances_received, $item->issuance;
1722             }
1723             $evt = _prepare_summaries($e, $issuances_received, $item->stream->distribution, $item->issuance->holding_type);
1724             if ($U->event_code($evt)) {
1725                 $e->rollback;
1726                 return $evt;
1727             }
1728
1729             # set the incontrovertibles on the unit
1730             $user_unit->edit_date("now");
1731             $user_unit->create_date("now");
1732             $user_unit->editor($user_id);
1733             $user_unit->creator($user_id);
1734
1735             return $e->die_event unless $e->create_serial_unit($user_unit);
1736
1737             # save reference to new unit
1738             $item->unit($e->data->id);
1739         }
1740
1741         # Create notes if given by user
1742         if (ref($item->notes) and @{$item->notes}) {
1743             foreach my $note (@{$item->notes}) {
1744                 $note->creator($user_id);
1745                 $note->create_date("now");
1746
1747                 return $e->die_event unless $e->create_serial_item_note($note);
1748             }
1749
1750             $item->clear_notes; # They're saved; we no longer want them here.
1751         }
1752
1753         # Set the incontrovertibles on the item
1754         $item->status("Received");
1755         $item->date_received("now");
1756         $item->edit_date("now");
1757         $item->editor($user_id);
1758
1759         return $e->die_event unless $e->update_serial_item($item);
1760
1761         # send client a response
1762         $client->respond($item->id);
1763     }
1764
1765     $e->commit or return $e->die_event;
1766     undef;
1767 }
1768
1769 sub _build_unit {
1770     my $editor = shift;
1771     my $sdist = shift;
1772     my $mode = shift;
1773     #my $skip_call_number = shift;
1774
1775     my $attr = $mode . '_unit_template';
1776     my $template = $editor->retrieve_asset_copy_template($sdist->$attr) or
1777         return new OpenILS::Event("SERIAL_DISTRIBUTION_HAS_NO_COPY_TEMPLATE");
1778
1779     my @parts = qw( status location loan_duration fine_level age_protect circulate deposit ref holdable deposit_amount price circ_modifier circ_as_type alert_message opac_visible floating mint_condition );
1780
1781     my $unit = new Fieldmapper::serial::unit;
1782     foreach my $part (@parts) {
1783         my $value = $template->$part;
1784         next if !defined($value);
1785         $unit->$part($value);
1786     }
1787
1788     # ignore circ_lib in template, set to distribution holding_lib
1789     $unit->circ_lib($sdist->holding_lib);
1790     $unit->creator($editor->requestor->id);
1791     $unit->editor($editor->requestor->id);
1792
1793 # XXX: this feature has been pushed back until after 2.0 at least
1794 #    unless ($skip_call_number) {
1795 #        $attr = $mode . '_call_number';
1796 #        my $cn = $sdist->$attr or
1797 #            return new OpenILS::Event("SERIAL_DISTRIBUTION_HAS_NO_CALL_NUMBER");
1798 #
1799 #        $unit->call_number($cn);
1800 #    }
1801     $unit->call_number('-1'); # default to the dummy call number
1802     $unit->barcode('@@PLACEHOLDER'); # generic unit will start with a generated placeholder barcode
1803     $unit->sort_key('');
1804     $unit->summary_contents('');
1805     $unit->detailed_contents('');
1806
1807     return $unit;
1808 }
1809
1810
1811 sub _summarize_contents {
1812     my $editor = shift;
1813     my $issuances = shift;
1814     my $sdist = shift;
1815
1816     # create or lookup MFHD record
1817     my $mfhd;
1818     if ($sdist and defined($sdist->record_entry) and $sdist->summary_method eq 'merge_with_sre') {
1819         my $sre;
1820         if (ref $sdist->record_entry) {
1821             $sre = $sdist->record_entry;
1822         } else {
1823             $sre = $editor->retrieve_serial_record_entry($sdist->record_entry);
1824         }
1825         $mfhd = MFHD->new(MARC::Record->new_from_xml($sre->marc));
1826     } else {
1827         $logger->info($sdist);
1828         $mfhd = MFHD->new(MARC::Record->new());
1829     }
1830
1831     my %scaps;
1832     my %scap_fields;
1833     my $seqno = 1;
1834     # We keep track of these separately to avoid link_id contamination,
1835     # e.g. a basic issuance, followed by a merging supplement, followed by
1836     # another basic.  If we could be sure that they were not mixed, one
1837     # value could suffice.
1838     my %link_ids = ('basic' => 10000, 'index' => 10000, 'supplement' => 10000);
1839     my %first_scap = ('basic' => 1, 'index' => 1, 'supplement' => 1);
1840     foreach my $issuance (@$issuances) {
1841         my $scap_id = $issuance->caption_and_pattern;
1842         next if (!$scap_id); # skip issuances with no caption/pattern
1843
1844         my $scap;
1845         my $scap_field;
1846         # if this is the first appearance of this scap, retrieve it and add it to the temporary record
1847         if (!exists $scaps{$issuance->caption_and_pattern}) {
1848             $scaps{$scap_id} = $editor->retrieve_serial_caption_and_pattern($scap_id);
1849             $scap = $scaps{$scap_id};
1850             $scap_field = _revive_caption($scap);
1851             my $did_merge = 0;
1852             if ($first_scap{$scap->type}) { # special merge processing
1853                 $first_scap{$MFHD_TAGS_BY_NAME{$scap->type}} = 0;
1854                 if ($sdist and $sdist->summary_method eq 'merge_with_sre') {
1855                     # MFHD Caption objects do not yet have a built-in compare (TODO), so let's do a basic one
1856                     my @field_85xs = $mfhd->field($MFHD_TAGS_BY_NAME{$scap->type});
1857                     if (@field_85xs) {
1858                         my $last_caption_field = $field_85xs[-1];
1859                         my $last_link_id = $last_caption_field->subfield('8');
1860                         # set the link id to match, temporarily, for comparison
1861                         $last_caption_field->update('8' => $scap_field->subfield('8'));
1862                         my $last_caption_json = OpenSRF::Utils::JSON->perl2JSON([$last_caption_field->indicator(1), $last_caption_field->indicator(2), $last_caption_field->subfields_list]);
1863                         if ($last_caption_json eq $scap->pattern_code) { # merge is possible, they match
1864                             # restore link id
1865                             $link_ids{$scap->type} = $last_link_id;
1866                             # set scap_field to last field
1867                             $scap_field = $last_caption_field;
1868                             $did_merge = 1;
1869                         }
1870                     }
1871                 }
1872             }
1873             $scap_fields{$scap_id} = $scap_field;
1874             $scap_field->update('8' => $link_ids{$scap->type});
1875             # TODO: make MFHD/Caption smarter about this
1876             $scap_field->{_mfhdc_LINK_ID} = $link_ids{$scap->type};
1877             $mfhd->append_fields($scap_field) if !$did_merge;
1878             $link_ids{$scap->type}++;
1879         } else {
1880             $scap_field = $scap_fields{$scap_id};
1881         }
1882
1883         $mfhd->append_fields(_revive_holding($issuance->holding_code, $scap_field, $seqno));
1884         $seqno++;
1885     }
1886
1887     my @formatted_parts;
1888     my @scap_fields_ordered = $mfhd->field('85[345]');
1889     foreach my $scap_field (@scap_fields_ordered) { #TODO: use generic MFHD "summarize" method, once available
1890        my @updated_holdings = $mfhd->get_compressed_holdings($scap_field);
1891        foreach my $holding (@updated_holdings) {
1892            push(@formatted_parts, $holding->format);
1893        }
1894     }
1895
1896     return ($mfhd, \@formatted_parts);
1897 }
1898
1899 ##########################################################################
1900 # note methods
1901 #
1902 __PACKAGE__->register_method(
1903     method      => 'fetch_notes',
1904     api_name        => 'open-ils.serial.item_note.retrieve.all',
1905     signature   => q/
1906         Returns an array of copy note objects.
1907         @param args A named hash of parameters including:
1908             authtoken   : Required if viewing non-public notes
1909             item_id      : The id of the item whose notes we want to retrieve
1910             pub         : True if all the caller wants are public notes
1911         @return An array of note objects
1912     /
1913 );
1914
1915 __PACKAGE__->register_method(
1916     method      => 'fetch_notes',
1917     api_name        => 'open-ils.serial.subscription_note.retrieve.all',
1918     signature   => q/
1919         Returns an array of copy note objects.
1920         @param args A named hash of parameters including:
1921             authtoken       : Required if viewing non-public notes
1922             subscription_id : The id of the item whose notes we want to retrieve
1923             pub             : True if all the caller wants are public notes
1924         @return An array of note objects
1925     /
1926 );
1927
1928 __PACKAGE__->register_method(
1929     method      => 'fetch_notes',
1930     api_name        => 'open-ils.serial.distribution_note.retrieve.all',
1931     signature   => q/
1932         Returns an array of copy note objects.
1933         @param args A named hash of parameters including:
1934             authtoken       : Required if viewing non-public notes
1935             distribution_id : The id of the item whose notes we want to retrieve
1936             pub             : True if all the caller wants are public notes
1937         @return An array of note objects
1938     /
1939 );
1940
1941 # TODO: revisit this method to consider replacing cstore direct calls
1942 sub fetch_notes {
1943     my( $self, $connection, $args ) = @_;
1944
1945     $self->api_name =~ /serial\.(\w*)_note/;
1946     my $type = $1;
1947
1948     my $id = $$args{object_id};
1949     my $authtoken = $$args{authtoken};
1950     my( $r, $evt);
1951
1952     if( $$args{pub} ) {
1953         return $U->cstorereq(
1954             'open-ils.cstore.direct.serial.'.$type.'_note.search.atomic',
1955             { $type => $id, pub => 't' } );
1956     } else {
1957         # FIXME: restore perm check
1958         # ( $r, $evt ) = $U->checksesperm($authtoken, 'VIEW_COPY_NOTES');
1959         # return $evt if $evt;
1960         return $U->cstorereq(
1961             'open-ils.cstore.direct.serial.'.$type.'_note.search.atomic', {$type => $id} );
1962     }
1963
1964     return undef;
1965 }
1966
1967 __PACKAGE__->register_method(
1968     method      => 'update_note',
1969     api_name        => 'open-ils.serial.item_note.update',
1970     signature   => q/
1971         Updates or creates an item note
1972         @param authtoken The login session key
1973         @param note The note object to update or create
1974         @return The id of the note object
1975     /
1976 );
1977
1978 __PACKAGE__->register_method(
1979     method      => 'update_note',
1980     api_name        => 'open-ils.serial.subscription_note.update',
1981     signature   => q/
1982         Updates or creates a subscription note
1983         @param authtoken The login session key
1984         @param note The note object to update or create
1985         @return The id of the note object
1986     /
1987 );
1988
1989 __PACKAGE__->register_method(
1990     method      => 'update_note',
1991     api_name        => 'open-ils.serial.distribution_note.update',
1992     signature   => q/
1993         Updates or creates a distribution note
1994         @param authtoken The login session key
1995         @param note The note object to update or create
1996         @return The id of the note object
1997     /
1998 );
1999
2000 sub update_note {
2001     my( $self, $connection, $authtoken, $note ) = @_;
2002
2003     $self->api_name =~ /serial\.(\w*)_note/;
2004     my $type = $1;
2005
2006     my $e = new_editor(xact=>1, authtoken=>$authtoken);
2007     return $e->event unless $e->checkauth;
2008
2009     if ($type eq 'item') {
2010         my $sitem = $e->retrieve_serial_item([
2011             $note->item, {
2012                 "flesh" => 2, "flesh_fields" => {
2013                     "sitem" => ["stream"], "sstr" => ["distribution"]
2014                 }
2015             }
2016         ]) or return $e->die_event;
2017
2018         return $e->die_event unless $e->allowed(
2019             "ADMIN_SERIAL_ITEM", $sitem->stream->distribution->holding_lib
2020         );
2021     } elsif ($type eq 'distribution') {
2022         my $sdist = $e->retrieve_serial_distribution($note->distribution)
2023             or return $e->die_event;
2024
2025         return $e->die_event unless
2026             $e->allowed("ADMIN_SERIAL_DISTRIBUTION", $sdist->holding_lib);
2027     } else { # subscription
2028         my $sub = $e->retrieve_serial_subscription($note->subscription)
2029             or return $e->die_event;
2030
2031         return $e->die_event unless
2032             $e->allowed("ADMIN_SERIAL_SUBSCRIPTION", $sub->owning_lib);
2033     }
2034
2035     $note->pub( ($U->is_true($note->pub)) ? 't' : 'f' );
2036     my $method;
2037     if ($note->isnew) {
2038         $note->create_date('now');
2039         $note->creator($e->requestor->id);
2040         $note->clear_id;
2041         $method = "create_serial_${type}_note";
2042     } else {
2043         $method = "update_serial_${type}_note";
2044     }
2045     $e->$method($note) or return $e->event;
2046     $e->commit;
2047     return $note->id;
2048 }
2049
2050 __PACKAGE__->register_method(
2051     method      => 'delete_note',
2052     api_name        =>  'open-ils.serial.item_note.delete',
2053     signature   => q/
2054         Deletes an existing item note
2055         @param authtoken The login session key
2056         @param noteid The id of the note to delete
2057         @return 1 on success - Event otherwise.
2058         /
2059 );
2060
2061 __PACKAGE__->register_method(
2062     method      => 'delete_note',
2063     api_name        =>  'open-ils.serial.subscription_note.delete',
2064     signature   => q/
2065         Deletes an existing subscription note
2066         @param authtoken The login session key
2067         @param noteid The id of the note to delete
2068         @return 1 on success - Event otherwise.
2069         /
2070 );
2071
2072 __PACKAGE__->register_method(
2073     method      => 'delete_note',
2074     api_name        =>  'open-ils.serial.distribution_note.delete',
2075     signature   => q/
2076         Deletes an existing distribution note
2077         @param authtoken The login session key
2078         @param noteid The id of the note to delete
2079         @return 1 on success - Event otherwise.
2080         /
2081 );
2082
2083 sub delete_note {
2084     my( $self, $conn, $authtoken, $noteid ) = @_;
2085
2086     $self->api_name =~ /serial\.(\w*)_note/;
2087     my $type = $1;
2088
2089     my $e = new_editor(xact=>1, authtoken=>$authtoken);
2090     return $e->die_event unless $e->checkauth;
2091
2092     my $method = "retrieve_serial_${type}_note";
2093     my $note = $e->$method([
2094         $noteid,
2095     ]) or return $e->die_event;
2096
2097     if ($type eq 'item') {
2098         my $sitem = $e->retrieve_serial_item([
2099             $note->item, {
2100                 "flesh" => 2, "flesh_fields" => {
2101                     "sitem" => ["stream"], "sstr" => ["distribution"]
2102                 }
2103             }
2104         ]) or return $e->die_event;
2105
2106         return $e->die_event unless $e->allowed(
2107             "ADMIN_SERIAL_ITEM", $sitem->stream->distribution->holding_lib
2108         );
2109     } elsif ($type eq 'distribution') {
2110         my $sdist = $e->retrieve_serial_distribution($note->distribution)
2111             or return $e->die_event;
2112
2113         return $e->die_event unless
2114             $e->allowed("ADMIN_SERIAL_DISTRIBUTION", $sdist->holding_lib);
2115     } else { # subscription
2116         my $sub = $e->retrieve_serial_subscription($note->subscription)
2117             or return $e->die_event;
2118
2119         return $e->die_event unless
2120             $e->allowed("ADMIN_SERIAL_SUBSCRIPTION", $sub->owning_lib);
2121     }
2122
2123     $method = "delete_serial_${type}_note";
2124     $e->$method($note) or return $e->die_event;
2125     $e->commit;
2126     return 1;
2127 }
2128
2129
2130 ##########################################################################
2131 # subscription methods
2132 #
2133 __PACKAGE__->register_method(
2134     method    => 'fleshed_ssub_alter',
2135     api_name  => 'open-ils.serial.subscription.fleshed.batch.update',
2136     api_level => 1,
2137     argc      => 2,
2138     signature => {
2139         desc     => 'Receives an array of one or more subscriptions and updates the database as needed',
2140         'params' => [ {
2141                  name => 'authtoken',
2142                  desc => 'Authtoken for current user session',
2143                  type => 'string'
2144             },
2145             {
2146                  name => 'subscriptions',
2147                  desc => 'Array of fleshed subscriptions',
2148                  type => 'array'
2149             }
2150
2151         ],
2152         'return' => {
2153             desc => 'Returns 1 if successful, event if failed',
2154             type => 'mixed'
2155         }
2156     }
2157 );
2158
2159 sub fleshed_ssub_alter {
2160     my( $self, $conn, $auth, $ssubs ) = @_;
2161     return 1 unless ref $ssubs;
2162     my( $reqr, $evt ) = $U->checkses($auth);
2163     return $evt if $evt;
2164     my $editor = new_editor(requestor => $reqr, xact => 1);
2165     my $override = $self->api_name =~ /override/;
2166
2167     for my $ssub (@$ssubs) {
2168         my $owning_lib_id = ref $ssub->owning_lib ? $ssub->owning_lib->id : $ssub->owning_lib;
2169         return $editor->die_event unless
2170             $editor->allowed("ADMIN_SERIAL_SUBSCRIPTION", $owning_lib_id);
2171
2172         my $ssubid = $ssub->id;
2173
2174         if( $ssub->isdeleted ) {
2175             $evt = _delete_ssub( $editor, $override, $ssub);
2176         } elsif( $ssub->isnew ) {
2177             _cleanse_dates($ssub, ['start_date','end_date']);
2178             $evt = _create_ssub( $editor, $ssub );
2179         } else {
2180             _cleanse_dates($ssub, ['start_date','end_date']);
2181             $evt = _update_ssub( $editor, $override, $ssub );
2182         }
2183     }
2184
2185     if( $evt ) {
2186         $logger->info("fleshed subscription-alter failed with event: ".OpenSRF::Utils::JSON->perl2JSON($evt));
2187         $editor->rollback;
2188         return $evt;
2189     }
2190     $logger->debug("subscription-alter: done updating subscription batch");
2191     $editor->commit;
2192     $logger->info("fleshed subscription-alter successfully updated ".scalar(@$ssubs)." subscriptions");
2193     return 1;
2194 }
2195
2196 sub _delete_ssub {
2197     my ($editor, $override, $ssub) = @_;
2198     $logger->info("subscription-alter: delete subscription ".OpenSRF::Utils::JSON->perl2JSON($ssub));
2199     my $sdists = $editor->search_serial_distribution(
2200             { subscription => $ssub->id }, { limit => 1 } ); #TODO: 'deleted' support?
2201     my $cps = $editor->search_serial_caption_and_pattern(
2202             { subscription => $ssub->id }, { limit => 1 } ); #TODO: 'deleted' support?
2203     my $sisses = $editor->search_serial_issuance(
2204             { subscription => $ssub->id }, { limit => 1 } ); #TODO: 'deleted' support?
2205     return OpenILS::Event->new(
2206             'SERIAL_SUBSCRIPTION_NOT_EMPTY', payload => $ssub->id ) if (@$sdists or @$cps or @$sisses);
2207
2208     return $editor->event unless $editor->delete_serial_subscription($ssub);
2209     return 0;
2210 }
2211
2212 sub _create_ssub {
2213     my ($editor, $ssub) = @_;
2214
2215     $logger->info("subscription-alter: new subscription ".OpenSRF::Utils::JSON->perl2JSON($ssub));
2216     return $editor->event unless $editor->create_serial_subscription($ssub);
2217     return 0;
2218 }
2219
2220 sub _update_ssub {
2221     my ($editor, $override, $ssub) = @_;
2222
2223     $logger->info("subscription-alter: retrieving subscription ".$ssub->id);
2224     my $orig_ssub = $editor->retrieve_serial_subscription($ssub->id);
2225
2226     $logger->info("subscription-alter: original subscription ".OpenSRF::Utils::JSON->perl2JSON($orig_ssub));
2227     $logger->info("subscription-alter: updated subscription ".OpenSRF::Utils::JSON->perl2JSON($ssub));
2228     return $editor->event unless $editor->update_serial_subscription($ssub);
2229     return 0;
2230 }
2231
2232 __PACKAGE__->register_method(
2233     method  => "fleshed_serial_subscription_retrieve_batch",
2234     authoritative => 1,
2235     api_name    => "open-ils.serial.subscription.fleshed.batch.retrieve"
2236 );
2237
2238 sub fleshed_serial_subscription_retrieve_batch {
2239     my( $self, $client, $ids ) = @_;
2240 # FIXME: permissions?
2241     $logger->info("Fetching fleshed subscriptions @$ids");
2242     return $U->cstorereq(
2243         "open-ils.cstore.direct.serial.subscription.search.atomic",
2244         { id => $ids },
2245         { flesh => 1,
2246           flesh_fields => {ssub => [ qw/owning_lib notes/ ]}
2247         });
2248 }
2249
2250 __PACKAGE__->register_method(
2251         method  => "retrieve_sub_tree",
2252     authoritative => 1,
2253         api_name        => "open-ils.serial.subscription_tree.retrieve"
2254 );
2255
2256 __PACKAGE__->register_method(
2257         method  => "retrieve_sub_tree",
2258         api_name        => "open-ils.serial.subscription_tree.global.retrieve"
2259 );
2260
2261 sub retrieve_sub_tree {
2262
2263         my( $self, $client, $user_session, $docid, @org_ids ) = @_;
2264
2265         if(ref($org_ids[0])) { @org_ids = @{$org_ids[0]}; }
2266
2267         $docid = "$docid";
2268
2269         # TODO: permission support
2270         if(!@org_ids and $user_session) {
2271                 my $user_obj =
2272                         OpenILS::Application::AppUtils->check_user_session( $user_session ); #throws EX on error
2273                         @org_ids = ($user_obj->home_ou);
2274         }
2275
2276         if( $self->api_name =~ /global/ ) {
2277                 return _build_subs_list( { record_entry => $docid } ); # TODO: filter for !deleted, or active?
2278
2279         } else {
2280
2281                 my @all_subs;
2282                 for my $orgid (@org_ids) {
2283                         my $subs = _build_subs_list(
2284                                         { record_entry => $docid, owning_lib => $orgid } );# TODO: filter for !deleted, or active?
2285                         push( @all_subs, @$subs );
2286                 }
2287
2288                 return \@all_subs;
2289         }
2290
2291         return undef;
2292 }
2293
2294 sub _build_subs_list {
2295         my $search_hash = shift;
2296
2297         #$search_hash->{deleted} = 'f';
2298         my $e = new_editor();
2299
2300         my $subs = $e->search_serial_subscription([$search_hash, { 'order_by' => {'ssub' => 'id'} }]);
2301
2302         my @built_subs;
2303
2304         for my $sub (@$subs) {
2305
2306         # TODO: filter on !deleted?
2307                 my $dists = $e->search_serial_distribution(
2308             [{ subscription => $sub->id }, { 'order_by' => {'sdist' => 'label'} }]
2309             );
2310
2311                 #$dists = [ sort { $a->label cmp $b->label } @$dists  ];
2312
2313                 $sub->distributions($dists);
2314
2315         # TODO: filter on !deleted?
2316                 my $issuances = $e->search_serial_issuance(
2317                         [{ subscription => $sub->id }, { 'order_by' => {'siss' => 'label'} }]
2318             );
2319
2320                 #$issuances = [ sort { $a->label cmp $b->label } @$issuances  ];
2321                 $sub->issuances($issuances);
2322
2323         # TODO: filter on !deleted?
2324                 my $scaps = $e->search_serial_caption_and_pattern(
2325                         [{ subscription => $sub->id }, { 'order_by' => {'scap' => 'id'} }]
2326             );
2327
2328                 #$scaps = [ sort { $a->id cmp $b->id } @$scaps  ];
2329                 $sub->scaps($scaps);
2330                 push( @built_subs, $sub );
2331         }
2332
2333         return \@built_subs;
2334
2335 }
2336
2337 __PACKAGE__->register_method(
2338     method  => "subscription_orgs_for_title",
2339     authoritative => 1,
2340     api_name    => "open-ils.serial.subscription.retrieve_orgs_by_title"
2341 );
2342
2343 sub subscription_orgs_for_title {
2344     my( $self, $client, $record_id ) = @_;
2345
2346     my $subs = $U->simple_scalar_request(
2347         "open-ils.cstore",
2348         "open-ils.cstore.direct.serial.subscription.search.atomic",
2349         { record_entry => $record_id }); # TODO: filter on !deleted?
2350
2351     my $orgs = { map {$_->owning_lib => 1 } @$subs };
2352     return [ keys %$orgs ];
2353 }
2354
2355
2356 ##########################################################################
2357 # distribution methods
2358 #
2359 __PACKAGE__->register_method(
2360     method    => 'fleshed_sdist_alter',
2361     api_name  => 'open-ils.serial.distribution.fleshed.batch.update',
2362     api_level => 1,
2363     argc      => 2,
2364     signature => {
2365         desc     => 'Receives an array of one or more distributions and updates the database as needed',
2366         'params' => [ {
2367                  name => 'authtoken',
2368                  desc => 'Authtoken for current user session',
2369                  type => 'string'
2370             },
2371             {
2372                  name => 'distributions',
2373                  desc => 'Array of fleshed distributions',
2374                  type => 'array'
2375             }
2376
2377         ],
2378         'return' => {
2379             desc => 'Returns 1 if successful, event if failed',
2380             type => 'mixed'
2381         }
2382     }
2383 );
2384
2385 sub fleshed_sdist_alter {
2386     my( $self, $conn, $auth, $sdists ) = @_;
2387     return 1 unless ref $sdists;
2388     my( $reqr, $evt ) = $U->checkses($auth);
2389     return $evt if $evt;
2390     my $editor = new_editor(requestor => $reqr, xact => 1);
2391     my $override = $self->api_name =~ /override/;
2392
2393     for my $sdist (@$sdists) {
2394         my $holding_lib_id = ref $sdist->holding_lib ? $sdist->holding_lib->id : $sdist->holding_lib;
2395         return $editor->die_event unless
2396             $editor->allowed("ADMIN_SERIAL_DISTRIBUTION", $holding_lib_id);
2397
2398         if( $sdist->isdeleted ) {
2399             $evt = _delete_sdist( $editor, $override, $sdist);
2400         } elsif( $sdist->isnew ) {
2401             $evt = _create_sdist( $editor, $sdist );
2402         } else {
2403             $evt = _update_sdist( $editor, $override, $sdist );
2404         }
2405     }
2406
2407     if( $evt ) {
2408         $logger->info("fleshed distribution-alter failed with event: ".OpenSRF::Utils::JSON->perl2JSON($evt));
2409         $editor->rollback;
2410         return $evt;
2411     }
2412     $logger->debug("distribution-alter: done updating distribution batch");
2413     $editor->commit;
2414     $logger->info("fleshed distribution-alter successfully updated ".scalar(@$sdists)." distributions");
2415     return 1;
2416 }
2417
2418 sub _delete_sdist {
2419     my ($editor, $override, $sdist) = @_;
2420     $logger->info("distribution-alter: delete distribution ".OpenSRF::Utils::JSON->perl2JSON($sdist));
2421     return $editor->event unless $editor->delete_serial_distribution($sdist);
2422     return 0;
2423 }
2424
2425 sub _create_sdist {
2426     my ($editor, $sdist) = @_;
2427
2428     $logger->info("distribution-alter: new distribution ".OpenSRF::Utils::JSON->perl2JSON($sdist));
2429     return $editor->event unless $editor->create_serial_distribution($sdist);
2430
2431     # create summaries too
2432     my $summary = new Fieldmapper::serial::basic_summary;
2433     $summary->distribution($sdist->id);
2434     $summary->generated_coverage('');
2435     return $editor->event unless $editor->create_serial_basic_summary($summary);
2436     $summary = new Fieldmapper::serial::supplement_summary;
2437     $summary->distribution($sdist->id);
2438     $summary->generated_coverage('');
2439     return $editor->event unless $editor->create_serial_supplement_summary($summary);
2440     $summary = new Fieldmapper::serial::index_summary;
2441     $summary->distribution($sdist->id);
2442     $summary->generated_coverage('');
2443     return $editor->event unless $editor->create_serial_index_summary($summary);
2444
2445     # create a starter stream (TODO: reconsider this)
2446     my $stream = new Fieldmapper::serial::stream;
2447     $stream->distribution($sdist->id);
2448     return $editor->event unless $editor->create_serial_stream($stream);
2449
2450     return 0;
2451 }
2452
2453 sub _update_sdist {
2454     my ($editor, $override, $sdist) = @_;
2455
2456     $logger->info("distribution-alter: retrieving distribution ".$sdist->id);
2457     my $orig_sdist = $editor->retrieve_serial_distribution($sdist->id);
2458
2459     $logger->info("distribution-alter: original distribution ".OpenSRF::Utils::JSON->perl2JSON($orig_sdist));
2460     $logger->info("distribution-alter: updated distribution ".OpenSRF::Utils::JSON->perl2JSON($sdist));
2461     return $editor->event unless $editor->update_serial_distribution($sdist);
2462     return 0;
2463 }
2464
2465 __PACKAGE__->register_method(
2466     method  => "fleshed_serial_distribution_retrieve_batch",
2467     authoritative => 1,
2468     api_name    => "open-ils.serial.distribution.fleshed.batch.retrieve"
2469 );
2470
2471 sub fleshed_serial_distribution_retrieve_batch {
2472     my( $self, $client, $ids ) = @_;
2473 # FIXME: permissions?
2474     $logger->info("Fetching fleshed distributions @$ids");
2475     return $U->cstorereq(
2476         "open-ils.cstore.direct.serial.distribution.search.atomic",
2477         { id => $ids },
2478         { flesh => 1,
2479           flesh_fields => {sdist => [ qw/ holding_lib receive_call_number receive_unit_template bind_call_number bind_unit_template streams notes / ]}
2480         });
2481 }
2482
2483 __PACKAGE__->register_method(
2484     method  => "retrieve_dist_tree",
2485     authoritative => 1,
2486     api_name    => "open-ils.serial.distribution_tree.retrieve"
2487 );
2488
2489 __PACKAGE__->register_method(
2490     method  => "retrieve_dist_tree",
2491     api_name    => "open-ils.serial.distribution_tree.global.retrieve"
2492 );
2493
2494 sub retrieve_dist_tree {
2495     my( $self, $client, $user_session, $docid, @org_ids ) = @_;
2496
2497     if(ref($org_ids[0])) { @org_ids = @{$org_ids[0]}; }
2498
2499     $docid = "$docid";
2500
2501     # TODO: permission support
2502     if(!@org_ids and $user_session) {
2503         my $user_obj =
2504             OpenILS::Application::AppUtils->check_user_session( $user_session ); #throws EX on error
2505             @org_ids = ($user_obj->home_ou);
2506     }
2507
2508     my $e = new_editor();
2509
2510     if( $self->api_name =~ /global/ ) {
2511         return $e->search_serial_distribution([{'+ssub' => { record_entry => $docid }},
2512             {   flesh => 1,
2513                 flesh_fields => {sdist => [ qw/ holding_lib receive_call_number receive_unit_template bind_call_number bind_unit_template streams basic_summary supplement_summary index_summary / ]},
2514                 order_by => {'sdist' => 'id'},
2515                 'join' => {'ssub' => {}}
2516             }
2517         ]); # TODO: filter for !deleted?
2518
2519     } else {
2520         my @all_dists;
2521         for my $orgid (@org_ids) {
2522             my $dists = $e->search_serial_distribution([{'+ssub' => { record_entry => $docid }, holding_lib => $orgid},
2523                 {   flesh => 1,
2524                     flesh_fields => {sdist => [ qw/ holding_lib receive_call_number receive_unit_template bind_call_number bind_unit_template streams basic_summary supplement_summary index_summary / ]},
2525                     order_by => {'sdist' => 'id'},
2526                     'join' => {'ssub' => {}}
2527                 }
2528             ]); # TODO: filter for !deleted?
2529             push( @all_dists, @$dists ) if $dists;
2530         }
2531
2532         return \@all_dists;
2533     }
2534
2535     return undef;
2536 }
2537
2538
2539 __PACKAGE__->register_method(
2540     method  => "distribution_orgs_for_title",
2541     authoritative => 1,
2542     api_name    => "open-ils.serial.distribution.retrieve_orgs_by_title"
2543 );
2544
2545 sub distribution_orgs_for_title {
2546     my( $self, $client, $record_id ) = @_;
2547
2548     my $dists = $U->cstorereq(
2549         "open-ils.cstore.direct.serial.distribution.search.atomic",
2550         { '+ssub' => { record_entry => $record_id } },
2551         { 'join' => {'ssub' => {}} }); # TODO: filter on !deleted?
2552
2553     my $orgs = { map {$_->holding_lib => 1 } @$dists };
2554     return [ keys %$orgs ];
2555 }
2556
2557
2558 ##########################################################################
2559 # caption and pattern methods
2560 #
2561 __PACKAGE__->register_method(
2562     method    => 'scap_alter',
2563     api_name  => 'open-ils.serial.caption_and_pattern.batch.update',
2564     api_level => 1,
2565     argc      => 2,
2566     signature => {
2567         desc     => 'Receives an array of one or more caption and patterns and updates the database as needed',
2568         'params' => [ {
2569                  name => 'authtoken',
2570                  desc => 'Authtoken for current user session',
2571                  type => 'string'
2572             },
2573             {
2574                  name => 'scaps',
2575                  desc => 'Array of caption and patterns',
2576                  type => 'array'
2577             }
2578
2579         ],
2580         'return' => {
2581             desc => 'Returns 1 if successful, event if failed',
2582             type => 'mixed'
2583         }
2584     }
2585 );
2586
2587 sub scap_alter {
2588     my( $self, $conn, $auth, $scaps ) = @_;
2589     return 1 unless ref $scaps;
2590     my( $reqr, $evt ) = $U->checkses($auth);
2591     return $evt if $evt;
2592     my $editor = new_editor(requestor => $reqr, xact => 1);
2593     my $override = $self->api_name =~ /override/;
2594
2595     my %found_ssub_ids;
2596     for my $scap (@$scaps) {
2597         if (!exists($found_ssub_ids{$scap->subscription})) {
2598             my $ssub = $editor->retrieve_serial_subscription($scap->subscription) or return $editor->die_event;
2599             return $editor->die_event unless
2600                 $editor->allowed("ADMIN_SERIAL_CAPTION_PATTERN", $ssub->owning_lib);
2601             $found_ssub_ids{$scap->subscription} = 1;
2602         }
2603
2604         if( $scap->isdeleted ) {
2605             $evt = _delete_scap( $editor, $override, $scap);
2606         } elsif( $scap->isnew ) {
2607             $evt = _create_scap( $editor, $scap );
2608         } else {
2609             $evt = _update_scap( $editor, $override, $scap );
2610         }
2611     }
2612
2613     if( $evt ) {
2614         $logger->info("caption_and_pattern-alter failed with event: ".OpenSRF::Utils::JSON->perl2JSON($evt));
2615         $editor->rollback;
2616         return $evt;
2617     }
2618     $logger->debug("caption_and_pattern-alter: done updating caption_and_pattern batch");
2619     $editor->commit;
2620     $logger->info("caption_and_pattern-alter successfully updated ".scalar(@$scaps)." caption_and_patterns");
2621     return 1;
2622 }
2623
2624 sub _delete_scap {
2625     my ($editor, $override, $scap) = @_;
2626     $logger->info("caption_and_pattern-alter: delete caption_and_pattern ".OpenSRF::Utils::JSON->perl2JSON($scap));
2627     my $sisses = $editor->search_serial_issuance(
2628             { caption_and_pattern => $scap->id }, { limit => 1 } ); #TODO: 'deleted' support?
2629     return OpenILS::Event->new(
2630             'SERIAL_CAPTION_AND_PATTERN_HAS_ISSUANCES', payload => $scap->id ) if (@$sisses);
2631
2632     return $editor->event unless $editor->delete_serial_caption_and_pattern($scap);
2633     return 0;
2634 }
2635
2636 sub _create_scap {
2637     my ($editor, $scap) = @_;
2638
2639     $logger->info("caption_and_pattern-alter: new caption_and_pattern ".OpenSRF::Utils::JSON->perl2JSON($scap));
2640     return $editor->event unless $editor->create_serial_caption_and_pattern($scap);
2641     return 0;
2642 }
2643
2644 sub _update_scap {
2645     my ($editor, $override, $scap) = @_;
2646
2647     $logger->info("caption_and_pattern-alter: retrieving caption_and_pattern ".$scap->id);
2648     my $orig_scap = $editor->retrieve_serial_caption_and_pattern($scap->id);
2649
2650     $logger->info("caption_and_pattern-alter: original caption_and_pattern ".OpenSRF::Utils::JSON->perl2JSON($orig_scap));
2651     $logger->info("caption_and_pattern-alter: updated caption_and_pattern ".OpenSRF::Utils::JSON->perl2JSON($scap));
2652     return $editor->event unless $editor->update_serial_caption_and_pattern($scap);
2653     return 0;
2654 }
2655
2656 __PACKAGE__->register_method(
2657     method  => "serial_caption_and_pattern_retrieve_batch",
2658     authoritative => 1,
2659     api_name    => "open-ils.serial.caption_and_pattern.batch.retrieve"
2660 );
2661
2662 sub serial_caption_and_pattern_retrieve_batch {
2663     my( $self, $client, $ids ) = @_;
2664     $logger->info("Fetching caption_and_patterns @$ids");
2665     return $U->cstorereq(
2666         "open-ils.cstore.direct.serial.caption_and_pattern.search.atomic",
2667         { id => $ids }
2668     );
2669 }
2670
2671 ##########################################################################
2672 # stream methods
2673 #
2674 __PACKAGE__->register_method(
2675     method    => 'sstr_alter',
2676     api_name  => 'open-ils.serial.stream.batch.update',
2677     api_level => 1,
2678     argc      => 2,
2679     signature => {
2680         desc     => 'Receives an array of one or more streams and updates the database as needed',
2681         'params' => [ {
2682                  name => 'authtoken',
2683                  desc => 'Authtoken for current user session',
2684                  type => 'string'
2685             },
2686             {
2687                  name => 'sstrs',
2688                  desc => 'Array of streams',
2689                  type => 'array'
2690             }
2691
2692         ],
2693         'return' => {
2694             desc => 'Returns 1 if successful, event if failed',
2695             type => 'mixed'
2696         }
2697     }
2698 );
2699
2700 sub sstr_alter {
2701     my( $self, $conn, $auth, $sstrs ) = @_;
2702     return 1 unless ref $sstrs;
2703     my( $reqr, $evt ) = $U->checkses($auth);
2704     return $evt if $evt;
2705     my $editor = new_editor(requestor => $reqr, xact => 1);
2706     my $override = $self->api_name =~ /override/;
2707
2708     my %found_sdist_ids;
2709     for my $sstr (@$sstrs) {
2710         if (!exists($found_sdist_ids{$sstr->distribution})) {
2711             my $sdist = $editor->retrieve_serial_distribution($sstr->distribution) or return $editor->die_event;
2712             return $editor->die_event unless
2713                 $editor->allowed("ADMIN_SERIAL_STREAM", $sdist->holding_lib);
2714             $found_sdist_ids{$sstr->distribution} = 1;
2715         }
2716
2717         if( $sstr->isdeleted ) {
2718             $evt = _delete_sstr( $editor, $override, $sstr);
2719         } elsif( $sstr->isnew ) {
2720             $evt = _create_sstr( $editor, $sstr );
2721         } else {
2722             $evt = _update_sstr( $editor, $override, $sstr );
2723         }
2724     }
2725
2726     if( $evt ) {
2727         $logger->info("stream-alter failed with event: ".OpenSRF::Utils::JSON->perl2JSON($evt));
2728         $editor->rollback;
2729         return $evt;
2730     }
2731     $logger->debug("stream-alter: done updating stream batch");
2732     $editor->commit;
2733     $logger->info("stream-alter successfully updated ".scalar(@$sstrs)." streams");
2734     return 1;
2735 }
2736
2737 sub _delete_sstr {
2738     my ($editor, $override, $sstr) = @_;
2739     $logger->info("stream-alter: delete stream ".OpenSRF::Utils::JSON->perl2JSON($sstr));
2740     my $sitems = $editor->search_serial_item(
2741             { stream => $sstr->id }, { limit => 1 } ); #TODO: 'deleted' support?
2742     return OpenILS::Event->new(
2743             'SERIAL_STREAM_HAS_ITEMS', payload => $sstr->id ) if (@$sitems);
2744
2745     return $editor->event unless $editor->delete_serial_stream($sstr);
2746     return 0;
2747 }
2748
2749 sub _create_sstr {
2750     my ($editor, $sstr) = @_;
2751
2752     $logger->info("stream-alter: new stream ".OpenSRF::Utils::JSON->perl2JSON($sstr));
2753     return $editor->event unless $editor->create_serial_stream($sstr);
2754     return 0;
2755 }
2756
2757 sub _update_sstr {
2758     my ($editor, $override, $sstr) = @_;
2759
2760     $logger->info("stream-alter: retrieving stream ".$sstr->id);
2761     my $orig_sstr = $editor->retrieve_serial_stream($sstr->id);
2762
2763     $logger->info("stream-alter: original stream ".OpenSRF::Utils::JSON->perl2JSON($orig_sstr));
2764     $logger->info("stream-alter: updated stream ".OpenSRF::Utils::JSON->perl2JSON($sstr));
2765     return $editor->event unless $editor->update_serial_stream($sstr);
2766     return 0;
2767 }
2768
2769 __PACKAGE__->register_method(
2770     method  => "serial_stream_retrieve_batch",
2771     authoritative => 1,
2772     api_name    => "open-ils.serial.stream.batch.retrieve"
2773 );
2774
2775 sub serial_stream_retrieve_batch {
2776     my( $self, $client, $ids ) = @_;
2777     $logger->info("Fetching streams @$ids");
2778     return $U->cstorereq(
2779         "open-ils.cstore.direct.serial.stream.search.atomic",
2780         { id => $ids }
2781     );
2782 }
2783
2784
2785 ##########################################################################
2786 # summary methods
2787 #
2788 __PACKAGE__->register_method(
2789     method    => 'sum_alter',
2790     api_name  => 'open-ils.serial.basic_summary.batch.update',
2791     api_level => 1,
2792     argc      => 2,
2793     signature => {
2794         desc     => 'Receives an array of one or more summaries and updates the database as needed',
2795         'params' => [ {
2796                  name => 'authtoken',
2797                  desc => 'Authtoken for current user session',
2798                  type => 'string'
2799             },
2800             {
2801                  name => 'sbsums',
2802                  desc => 'Array of basic summaries',
2803                  type => 'array'
2804             }
2805
2806         ],
2807         'return' => {
2808             desc => 'Returns 1 if successful, event if failed',
2809             type => 'mixed'
2810         }
2811     }
2812 );
2813
2814 __PACKAGE__->register_method(
2815     method    => 'sum_alter',
2816     api_name  => 'open-ils.serial.supplement_summary.batch.update',
2817     api_level => 1,
2818     argc      => 2,
2819     signature => {
2820         desc     => 'Receives an array of one or more summaries and updates the database as needed',
2821         'params' => [ {
2822                  name => 'authtoken',
2823                  desc => 'Authtoken for current user session',
2824                  type => 'string'
2825             },
2826             {
2827                  name => 'sbsums',
2828                  desc => 'Array of supplement summaries',
2829                  type => 'array'
2830             }
2831
2832         ],
2833         'return' => {
2834             desc => 'Returns 1 if successful, event if failed',
2835             type => 'mixed'
2836         }
2837     }
2838 );
2839
2840 __PACKAGE__->register_method(
2841     method    => 'sum_alter',
2842     api_name  => 'open-ils.serial.index_summary.batch.update',
2843     api_level => 1,
2844     argc      => 2,
2845     signature => {
2846         desc     => 'Receives an array of one or more summaries and updates the database as needed',
2847         'params' => [ {
2848                  name => 'authtoken',
2849                  desc => 'Authtoken for current user session',
2850                  type => 'string'
2851             },
2852             {
2853                  name => 'sbsums',
2854                  desc => 'Array of index summaries',
2855                  type => 'array'
2856             }
2857
2858         ],
2859         'return' => {
2860             desc => 'Returns 1 if successful, event if failed',
2861             type => 'mixed'
2862         }
2863     }
2864 );
2865
2866 sub sum_alter {
2867     my( $self, $conn, $auth, $sums ) = @_;
2868     return 1 unless ref $sums;
2869
2870     $self->api_name =~ /serial\.(\w*)_summary/;
2871     my $type = $1;
2872
2873     my( $reqr, $evt ) = $U->checkses($auth);
2874     return $evt if $evt;
2875     my $editor = new_editor(requestor => $reqr, xact => 1);
2876     my $override = $self->api_name =~ /override/;
2877
2878     my %found_sdist_ids;
2879     for my $sum (@$sums) {
2880         if (!exists($found_sdist_ids{$sum->distribution})) {
2881             my $sdist = $editor->retrieve_serial_distribution($sum->distribution) or return $editor->die_event;
2882             return $editor->die_event unless
2883                 $editor->allowed("ADMIN_SERIAL_DISTRIBUTION", $sdist->holding_lib);
2884             $found_sdist_ids{$sum->distribution} = 1;
2885         }
2886
2887         # XXX: (for now, at least) summaries should be created/deleted by the distribution functions
2888         if( $sum->isdeleted ) {
2889             $evt = OpenILS::Event->new('SERIAL_SUMMARIES_NOT_INDEPENDENT');
2890         } elsif( $sum->isnew ) {
2891             $evt = OpenILS::Event->new('SERIAL_SUMMARIES_NOT_INDEPENDENT');
2892         } else {
2893             $evt = _update_sum( $editor, $override, $sum, $type );
2894         }
2895     }
2896
2897     if( $evt ) {
2898         $logger->info("${type}_summary-alter failed with event: ".OpenSRF::Utils::JSON->perl2JSON($evt));
2899         $editor->rollback;
2900         return $evt;
2901     }
2902     $logger->debug("${type}_summary-alter: done updating ${type}_summary batch");
2903     $editor->commit;
2904     $logger->info("${type}_summary-alter successfully updated ".scalar(@$sums)." ${type}_summaries");
2905     return 1;
2906 }
2907
2908 sub _update_sum {
2909     my ($editor, $override, $sum, $type) = @_;
2910
2911     $logger->info("${type}_summary-alter: retrieving ${type}_summary ".$sum->id);
2912     my $retrieve_method = "retrieve_serial_${type}_summary";
2913     my $orig_sum = $editor->$retrieve_method($sum->id);
2914
2915     $logger->info("${type}_summary-alter: original ${type}_summary ".OpenSRF::Utils::JSON->perl2JSON($orig_sum));
2916     $logger->info("${type}_summary-alter: updated ${type}_summary ".OpenSRF::Utils::JSON->perl2JSON($sum));
2917     my $update_method = "update_serial_${type}_summary";
2918     return $editor->event unless $editor->$update_method($sum);
2919     return 0;
2920 }
2921
2922 __PACKAGE__->register_method(
2923     method  => "serial_summary_retrieve_batch",
2924     authoritative => 1,
2925     api_name    => "open-ils.serial.basic_summary.batch.retrieve"
2926 );
2927
2928 __PACKAGE__->register_method(
2929     method  => "serial_summary_retrieve_batch",
2930     authoritative => 1,
2931     api_name    => "open-ils.serial.supplement_summary.batch.retrieve"
2932 );
2933
2934 __PACKAGE__->register_method(
2935     method  => "serial_summary_retrieve_batch",
2936     authoritative => 1,
2937     api_name    => "open-ils.serial.index_summary.batch.retrieve"
2938 );
2939
2940 sub serial_summary_retrieve_batch {
2941     my( $self, $client, $ids ) = @_;
2942
2943     $self->api_name =~ /serial\.(\w*)_summary/;
2944     my $type = $1;
2945
2946     $logger->info("Fetching ${type}_summaries @$ids");
2947     return $U->cstorereq(
2948         "open-ils.cstore.direct.serial.".$type."_summary.search.atomic",
2949         { id => $ids }
2950     );
2951 }
2952
2953
2954 ##########################################################################
2955 # other methods
2956 #
2957 __PACKAGE__->register_method(
2958     "method" => "bre_by_identifier",
2959     "api_name" => "open-ils.serial.biblio.record_entry.by_identifier",
2960     "stream" => 1,
2961     "signature" => {
2962         "desc" => "Find instances of biblio.record_entry given a search token" .
2963             " that could be a value for any identifier defined in " .
2964             "config.metabib_field",
2965         "params" => [
2966             {"desc" => "Search token", "type" => "string"},
2967             {"desc" => "Options: require_subscriptions, add_mvr, is_actual_id" .
2968                 ", id_list (all boolean)", "type" => "object"}
2969         ],
2970         "return" => {
2971             "desc" => "Any matching BREs, or if the add_mvr option is true, " .
2972                 "objects with a 'bre' key/value pair, and an 'mvr' " .
2973                 "key-value pair.  BREs have subscriptions fleshed on.",
2974             "type" => "object"
2975         }
2976     }
2977 );
2978
2979 sub bre_by_identifier {
2980     my ($self, $client, $term, $options) = @_;
2981
2982     return new OpenILS::Event("BAD_PARAMS") unless $term;
2983
2984     $options ||= {};
2985     my $e = new_editor();
2986
2987     my @ids;
2988
2989     if ($options->{"is_actual_id"}) {
2990         @ids = ($term);
2991     } else {
2992         my $cmf =
2993             $e->search_config_metabib_field({"field_class" => "identifier"})
2994                 or return $e->die_event;
2995
2996         my @identifiers = map { $_->name } @$cmf;
2997         my $query = join(" || ", map { "id|$_: $term" } @identifiers);
2998
2999         my $search = create OpenSRF::AppSession("open-ils.search");
3000         my $search_result = $search->request(
3001             "open-ils.search.biblio.multiclass.query.staff", {}, $query
3002         )->gather(1);
3003         $search->disconnect;
3004
3005         # Un-nest results. They tend to look like [[1],[2],[3]] for some reason.
3006         @ids = map { @{$_} } @{$search_result->{"ids"}};
3007
3008         unless (@ids) {
3009             $e->disconnect;
3010             return undef;
3011         }
3012
3013         if ($options->{"id_list"}) {
3014             $e->disconnect;
3015             $client->respond($_) foreach (@ids);
3016             return undef;
3017         }
3018     }
3019
3020     my $bre = $e->search_biblio_record_entry([
3021         {"id" => \@ids}, {
3022             "flesh" => 2, "flesh_fields" => {
3023                 "bre" => ["subscriptions"],
3024                 "ssub" => ["owning_lib"]
3025             }
3026         }
3027     ]) or return $e->die_event;
3028
3029     if (@$bre && $options->{"require_subscriptions"}) {
3030         $bre = [ grep { @{$_->subscriptions} } @$bre ];
3031     }
3032
3033     $e->disconnect;
3034
3035     if (@$bre) { # re-evaluate after possible grep
3036         if ($options->{"add_mvr"}) {
3037             $client->respond(
3038                 {"bre" => $_, "mvr" => _get_mvr($_->id)}
3039             ) foreach (@$bre);
3040         } else {
3041             $client->respond($_) foreach (@$bre);
3042         }
3043     }
3044
3045     undef;
3046 }
3047
3048 __PACKAGE__->register_method(
3049     "method" => "get_items_by",
3050     "api_name" => "open-ils.serial.items.receivable.by_subscription",
3051     "stream" => 1,
3052     "signature" => {
3053         "desc" => "Return all receivable items under a given subscription",
3054         "params" => [
3055             {"desc" => "Authtoken", "type" => "string"},
3056             {"desc" => "Subscription ID", "type" => "number"},
3057         ],
3058         "return" => {
3059             "desc" => "All receivable items under a given subscription",
3060             "type" => "object", "class" => "sitem"
3061         }
3062     }
3063 );
3064
3065 __PACKAGE__->register_method(
3066     "method" => "get_items_by",
3067     "api_name" => "open-ils.serial.items.receivable.by_issuance",
3068     "stream" => 1,
3069     "signature" => {
3070         "desc" => "Return all receivable items under a given issuance",
3071         "params" => [
3072             {"desc" => "Authtoken", "type" => "string"},
3073             {"desc" => "Issuance ID", "type" => "number"},
3074         ],
3075         "return" => {
3076             "desc" => "All receivable items under a given issuance",
3077             "type" => "object", "class" => "sitem"
3078         }
3079     }
3080 );
3081
3082 __PACKAGE__->register_method(
3083     "method" => "get_items_by",
3084     "api_name" => "open-ils.serial.items.by_issuance",
3085     "stream" => 1,
3086     "signature" => {
3087         "desc" => "Return all items under a given issuance",
3088         "params" => [
3089             {"desc" => "Authtoken", "type" => "string"},
3090             {"desc" => "Issuance ID", "type" => "number"},
3091         ],
3092         "return" => {
3093             "desc" => "All items under a given issuance",
3094             "type" => "object", "class" => "sitem"
3095         }
3096     }
3097 );
3098
3099 sub get_items_by {
3100     my ($self, $client, $auth, $term, $opts)  = @_;
3101
3102     # Not to be used in the json_query, but after limiting by perm check.
3103     $opts = {} unless ref $opts eq "HASH";
3104     $opts->{"limit"} ||= 10000;    # some existing users may want all results
3105     $opts->{"offset"} ||= 0;
3106     $opts->{"limit"} = int($opts->{"limit"});
3107     $opts->{"offset"} = int($opts->{"offset"});
3108
3109     my $e = new_editor("authtoken" => $auth);
3110     return $e->die_event unless $e->checkauth;
3111
3112     my $by = ($self->api_name =~ /by_(\w+)$/)[0];
3113     my $receivable = ($self->api_name =~ /receivable/);
3114
3115     my %where = (
3116         "issuance" => {"issuance" => $term},
3117         "subscription" => {"+siss" => {"subscription" => $term}}
3118     );
3119
3120     my $item_rows = $e->json_query(
3121         {
3122             "select" => {"sitem" => ["id"], "sdist" => ["holding_lib"]},
3123             "from" => {
3124                 "sitem" => {
3125                     "siss" => {},
3126                     "sstr" => {"join" => {"sdist" => {}}}
3127                 }
3128             },
3129             "where" => {
3130                 %{$where{$by}}, $receivable ? ("date_received" => undef) : ()
3131             },
3132             "order_by" => {"sitem" => ["id"]}
3133         }
3134     ) or return $e->die_event;
3135
3136     return undef unless @$item_rows;
3137
3138     my $skipped = 0;
3139     my $returned = 0;
3140     foreach (@$item_rows) {
3141         last if $returned >= $opts->{"limit"};
3142         next unless $e->allowed("RECEIVE_SERIAL", $_->{"holding_lib"});
3143         if ($skipped < $opts->{"offset"}) {
3144             $skipped++;
3145             next;
3146         }
3147
3148         $client->respond(
3149             $e->retrieve_serial_item([
3150                 $_->{"id"}, {
3151                     "flesh" => 3,
3152                     "flesh_fields" => {
3153                         "sitem" => [qw/stream issuance unit creator editor/],
3154                         "sstr" => ["distribution"],
3155                         "sdist" => ["holding_lib"]
3156                     }
3157                 }
3158             ])
3159         );
3160         $returned++;
3161     }
3162
3163     $e->disconnect;
3164     undef;
3165 }
3166
3167 __PACKAGE__->register_method(
3168     "method" => "get_receivable_issuances",
3169     "api_name" => "open-ils.serial.issuances.receivable",
3170     "stream" => 1,
3171     "signature" => {
3172         "desc" => "Return all issuances with receivable items given " .
3173             "a subscription ID",
3174         "params" => [
3175             {"desc" => "Authtoken", "type" => "string"},
3176             {"desc" => "Subscription ID", "type" => "number"},
3177         ],
3178         "return" => {
3179             "desc" => "All issuances with receivable items " .
3180                 "(but not the items themselves)", "type" => "object"
3181         }
3182     }
3183 );
3184
3185 sub get_receivable_issuances {
3186     my ($self, $client, $auth, $sub_id) = @_;
3187
3188     my $e = new_editor("authtoken" => $auth);
3189     return $e->die_event unless $e->checkauth;
3190
3191     # XXX permissions
3192
3193     my $issuance_ids = $e->json_query({
3194         "select" => {
3195             "siss" => [
3196                 {"transform" => "distinct", "column" => "id"},
3197                 "date_published"
3198             ]
3199         },
3200         "from" => {"siss" => "sitem"},
3201         "where" => {
3202             "subscription" => $sub_id,
3203             "+sitem" => {"date_received" => undef}
3204         },
3205         "order_by" => {
3206             "siss" => {"date_published" => {"direction" => "asc"}}
3207         }
3208
3209     }) or return $e->die_event;
3210
3211     $client->respond($e->retrieve_serial_issuance($_->{"id"}))
3212         foreach (@$issuance_ids);
3213
3214     $e->disconnect;
3215     undef;
3216 }
3217
3218
3219 __PACKAGE__->register_method(
3220     "method" => "get_routing_list_users",
3221     "api_name" => "open-ils.serial.routing_list_users.fleshed_and_ordered",
3222     "stream" => 1,
3223     "signature" => {
3224         "desc" => "Return all routing list users with reader fleshed " .
3225             "(with card and home_ou) for a given stream ID, sorted by pos",
3226         "params" => [
3227             {"desc" => "Authtoken", "type" => "string"},
3228             {"desc" => "Stream ID (int or array of ints)", "type" => "mixed"},
3229         ],
3230         "return" => {
3231             "desc" => "Stream of routing list users", "type" => "object",
3232                 "class" => "srlu"
3233         }
3234     }
3235 );
3236
3237 sub get_routing_list_users {
3238     my ($self, $client, $auth, $stream_id) = @_;
3239
3240     my $e = new_editor("authtoken" => $auth);
3241     return $e->die_event unless $e->checkauth;
3242
3243     my $users = $e->search_serial_routing_list_user([
3244         {"stream" => $stream_id}, {
3245             "order_by" => {"srlu" => "pos"},
3246             "flesh" => 2,
3247             "flesh_fields" => {
3248                 "srlu" => [qw/reader stream/],
3249                 "au" => [qw/card home_ou/],
3250                 "sstr" => ["distribution"]
3251             }
3252         }
3253     ]) or return $e->die_event;
3254
3255     return undef unless @$users;
3256
3257     # The ADMIN_SERIAL_STREAM permission is used simply to avoid the
3258     # need for any new permission.  The context OU will be the same
3259     # for every result of the above query, so we need only check once.
3260     return $e->die_event unless $e->allowed(
3261         "ADMIN_SERIAL_STREAM", $users->[0]->stream->distribution->holding_lib
3262     );
3263
3264     $e->disconnect;
3265
3266     my @users = map { $_->stream($_->stream->id); $_ } @$users;
3267     @users = sort { $a->stream cmp $b->stream } @users if
3268         ref $stream_id eq "ARRAY";
3269
3270     $client->respond($_) for @users;
3271
3272     undef;
3273 }
3274
3275
3276 __PACKAGE__->register_method(
3277     "method" => "replace_routing_list_users",
3278     "api_name" => "open-ils.serial.routing_list_users.replace",
3279     "signature" => {
3280         "desc" => "Replace all routing list users on the specified streams " .
3281             "with those in the list argument",
3282         "params" => [
3283             {"desc" => "Authtoken", "type" => "string"},
3284             {"desc" => "List of srlu objects", "type" => "array"},
3285         ],
3286         "return" => {
3287             "desc" => "event on failure, undef on success"
3288         }
3289     }
3290 );
3291
3292 sub replace_routing_list_users {
3293     my ($self, $client, $auth, $users) = @_;
3294
3295     return undef unless ref $users eq "ARRAY";
3296
3297     if (grep { ref $_ ne "Fieldmapper::serial::routing_list_user" } @$users) {
3298         return new OpenILS::Event("BAD_PARAMS", "note" => "Only srlu objects");
3299     }
3300
3301     my $e = new_editor("authtoken" => $auth, "xact" => 1);
3302     return $e->die_event unless $e->checkauth;
3303
3304     my %streams_ok = ();
3305     my $pos = 0;
3306
3307     foreach my $user (@$users) {
3308         unless (exists $streams_ok{$user->stream}) {
3309             my $stream = $e->retrieve_serial_stream([
3310                 $user->stream, {
3311                     "flesh" => 1,
3312                     "flesh_fields" => {"sstr" => ["distribution"]}
3313                 }
3314             ]) or return $e->die_event;
3315             $e->allowed(
3316                 "ADMIN_SERIAL_STREAM", $stream->distribution->holding_lib
3317             ) or return $e->die_event;
3318
3319             my $to_delete = $e->search_serial_routing_list_user(
3320                 {"stream" => $user->stream}
3321             ) or return $e->die_event;
3322
3323             $logger->info(
3324                 "Deleting srlu: [" .
3325                 join(", ", map { $_->id; } @$to_delete) .
3326                 "]"
3327             );
3328
3329             foreach (@$to_delete) {
3330                 $e->delete_serial_routing_list_user($_) or
3331                     return $e->die_event;
3332             }
3333
3334             $streams_ok{$user->stream} = 1;
3335         }
3336
3337         next if $user->isdeleted;
3338
3339         $user->clear_id;
3340         $user->pos($pos++);
3341         $e->create_serial_routing_list_user($user) or return $e->die_event;
3342     }
3343
3344     $e->commit or return $e->die_event;
3345     undef;
3346 }
3347
3348 __PACKAGE__->register_method(
3349     "method" => "get_records_with_marc_85x",
3350     "api_name"=>"open-ils.serial.caption_and_pattern.find_legacy_by_bib_record",
3351     "stream" => 1,
3352     "signature" => {
3353         "desc" => "Return the specified BRE itself and/or any related SRE ".
3354             "whenever they have 853-855 tags",
3355         "params" => [
3356             {"desc" => "Authtoken", "type" => "string"},
3357             {"desc" => "bib record ID", "type" => "number"},
3358         ],
3359         "return" => {
3360             "desc" => "objects, either bre or sre", "type" => "object"
3361         }
3362     }
3363 );
3364
3365 sub get_records_with_marc_85x { # specifically, 853-855
3366     my ($self, $client, $auth, $bre_id) = @_;
3367
3368     my $e = new_editor("authtoken" => $auth);
3369     return $e->die_event unless $e->checkauth;
3370
3371     my $bre = $e->search_biblio_record_entry([
3372         {"id" => $bre_id, "deleted" => "f"}, {
3373             "flesh" => 1,
3374             "flesh_fields" => {"bre" => [qw/creator editor owner/]}
3375         }
3376     ]) or return $e->die_event;
3377
3378     return undef unless @$bre;
3379     $bre = $bre->[0];
3380
3381     my $record = MARC::Record->new_from_xml($bre->marc);
3382     $client->respond($bre) if $record->field("85[3-5]");
3383     # XXX Is passing a regex to ->field() an abuse of MARC::Record ?
3384
3385     my $sres = $e->search_serial_record_entry([
3386         {"record" => $bre_id, "deleted" => "f"}, {
3387             "flesh" => 1,
3388             "flesh_fields" => {"sre" => [qw/creator editor owning_lib/]}
3389         }
3390     ]) or return $e->die_event;
3391
3392     $e->disconnect;
3393
3394     foreach my $sre (@$sres) {
3395         $client->respond($sre) if
3396             MARC::Record->new_from_xml($sre->marc)->field("85[3-5]");
3397     }
3398
3399     undef;
3400 }
3401
3402 __PACKAGE__->register_method(
3403     "method" => "create_scaps_from_marcxml",
3404     "api_name" => "open-ils.serial.caption_and_pattern.create_from_records",
3405     "stream" => 1,
3406     "signature" => {
3407         "desc" => "Create caption and pattern objects from 853-855 tags " .
3408             "in MARCXML documents",
3409         "params" => [
3410             {"desc" => "Authtoken", "type" => "string"},
3411             {"desc" => "Subscription ID", "type" => "number"},
3412             {"desc" => "list of MARCXML documents as strings",
3413                 "type" => "array"},
3414         ],
3415         "return" => {
3416             "desc" => "Newly created caption and pattern objects",
3417             "type" => "object", "class" => "scap"
3418         }
3419     }
3420 );
3421
3422 sub create_scaps_from_marcxml {
3423     my ($self, $client, $auth, $sub_id, $docs) = @_;
3424
3425     return undef unless ref $docs eq "ARRAY";
3426
3427     my $e = new_editor("authtoken" => $auth, "xact" => 1);
3428     return $e->die_event unless $e->checkauth;
3429
3430     # Retrieve the subscription just for perm checking (whether we can create
3431     # scaps at the owning lib).
3432     my $sub = $e->retrieve_serial_subscription($sub_id) or return $e->die_event;
3433     return $e->die_event unless
3434         $e->allowed("ADMIN_SERIAL_CAPTION_PATTERN", $sub->owning_lib);
3435
3436     foreach my $record (map { MARC::Record->new_from_xml($_) } @$docs) {
3437         foreach my $field ($record->field("85[3-5]")) {
3438             my $scap = new Fieldmapper::serial::caption_and_pattern;
3439             $scap->subscription($sub_id);
3440             $scap->type($MFHD_NAMES_BY_TAG{$field->tag});
3441             $scap->pattern_code(
3442                 OpenSRF::Utils::JSON->perl2JSON(
3443                     [ $field->indicator(1), $field->indicator(2),
3444                         map { @$_ } $field->subfields ] # flattens nested array
3445                 )
3446             );
3447             $e->create_serial_caption_and_pattern($scap) or
3448                 return $e->die_event;
3449             $client->respond($e->data);
3450         }
3451     }
3452
3453     $e->commit or return $e->die_event;
3454     undef;
3455 }
3456
3457 # All these _clone_foo() functions could possibly have been consolidated into
3458 # one clever function, but it's faster to get things working this way.
3459 sub _clone_subscription {
3460     my ($sub, $bib_id, $e) = @_;
3461
3462     # clone sub itself
3463     my $new_sub = $sub->clone;
3464     $new_sub->record_entry(int $bib_id) if $bib_id;
3465     $new_sub->clear_id;
3466     $new_sub->clear_distributions;
3467     $new_sub->clear_notes;
3468     $new_sub->clear_scaps;
3469
3470     $e->create_serial_subscription($new_sub) or return $e->die_event;
3471
3472     my $new_sub_id = $e->data->id;
3473     # clone dists
3474     foreach my $dist (@{$sub->distributions}) {
3475         my $r = _clone_distribution($dist, $new_sub_id, $e);
3476         return $r if $U->event_code($r);
3477     }
3478
3479     # clone sub notes
3480     foreach my $note (@{$sub->notes}) {
3481         my $r = _clone_subscription_note($note, $new_sub_id, $e);
3482         return $r if $U->event_code($r);
3483     }
3484
3485     # clone scaps
3486     foreach my $scap (@{$sub->scaps}) {
3487         my $r = _clone_caption_and_pattern($scap, $new_sub_id, $e);
3488         return $r if $U->event_code($r);
3489     }
3490
3491     return $new_sub_id;
3492 }
3493
3494 sub _clone_distribution {
3495     my ($dist, $sub_id, $e) = @_;
3496
3497     my $new_dist = $dist->clone;
3498     $new_dist->clear_id;
3499     $new_dist->clear_notes;
3500     $new_dist->clear_streams;
3501     $new_dist->subscription($sub_id);
3502
3503     $e->create_serial_distribution($new_dist) or return $e->die_event;
3504     my $new_dist_id = $e->data->id;
3505
3506     # clone streams
3507     foreach my $stream (@{$dist->streams}) {
3508         my $r = _clone_stream($stream, $new_dist_id, $e);
3509         return $r if $U->event_code($r);
3510     }
3511
3512     # clone distribution notes
3513     foreach my $note (@{$dist->notes}) {
3514         my $r = _clone_distribution_note($note, $new_dist_id, $e);
3515         return $r if $U->event_code($r);
3516     }
3517
3518     return $new_dist_id;
3519 }
3520
3521 sub _clone_subscription_note {
3522     my ($note, $sub_id, $e) = @_;
3523
3524     my $new_note = $note->clone;
3525     $new_note->clear_id;
3526     $new_note->creator($e->requestor->id);
3527     $new_note->create_date("now");
3528     $new_note->subscription($sub_id);
3529
3530     $e->create_serial_subscription_note($new_note) or return $e->die_event;
3531     return $e->data->id;
3532 }
3533
3534 sub _clone_caption_and_pattern {
3535     my ($scap, $sub_id, $e) = @_;
3536
3537     my $new_scap = $scap->clone;
3538     $new_scap->clear_id;
3539     $new_scap->subscription($sub_id);
3540
3541     $e->create_serial_caption_and_pattern($new_scap) or return $e->die_event;
3542     return $e->data->id;
3543 }
3544
3545 sub _clone_distribution_note {
3546     my ($note, $dist_id, $e) = @_;
3547
3548     my $new_note = $note->clone;
3549     $new_note->clear_id;
3550     $new_note->creator($e->requestor->id);
3551     $new_note->create_date("now");
3552     $new_note->distribution($dist_id);
3553
3554     $e->create_serial_distribution_note($new_note) or return $e->die_event;
3555     return $e->data->id;
3556 }
3557
3558 sub _clone_stream {
3559     my ($stream, $dist_id, $e) = @_;
3560
3561     my $new_stream = $stream->clone;
3562     $new_stream->clear_id;
3563     $new_stream->clear_routing_list_users;
3564     $new_stream->distribution($dist_id);
3565
3566     $e->create_serial_stream($new_stream) or return $e->die_event;
3567     my $new_stream_id = $e->data->id;
3568
3569     # clone routing list users
3570     foreach my $user (@{$stream->routing_list_users}) {
3571         my $r = _clone_routing_list_user($user, $new_stream_id, $e);
3572         return $r if $U->event_code($r);
3573     }
3574
3575     return $new_stream_id;
3576 }
3577
3578 sub _clone_routing_list_user {
3579     my ($user, $stream_id, $e) = @_;
3580
3581     my $new_user = $user->clone;
3582     $new_user->clear_id;
3583     $new_user->stream($stream_id);
3584
3585     $e->create_serial_routing_list_user($new_user) or return $e->die_event;
3586     return $e->data->id;
3587 }
3588
3589 __PACKAGE__->register_method(
3590     "method" => "clone_subscription",
3591     "api_name" => "open-ils.serial.subscription.clone",
3592     "signature" => {
3593         "desc" => q{Clone a subscription, including its attending distributions,
3594             streams, captions and patterns, routing list users, distribution
3595             notes and subscription notes. Do not include holdings-specific
3596             things, like issuances, items, units, summaries. Attach the
3597             clone either to the same bib record as the original, or to one
3598             specified by ID.},
3599         "params" => [
3600             {"desc" => "Authtoken", "type" => "string"},
3601             {"desc" => "Subscription ID", "type" => "number"},
3602             {"desc" => "Bib Record ID (optional)", "type" => "number"}
3603         ],
3604         "return" => {
3605             "desc" => "ID of the new subscription", "type" => "number"
3606         }
3607     }
3608 );
3609
3610 sub clone_subscription {
3611     my ($self, $client, $auth, $sub_id, $bib_id) = @_;
3612
3613     my $e = new_editor("authtoken" => $auth, "xact" => 1);
3614     return $e->die_event unless $e->checkauth;
3615
3616     my $sub = $e->retrieve_serial_subscription([
3617         int $sub_id, {
3618             "flesh" => 3,
3619             "flesh_fields" => {
3620                 "ssub" => [qw/distributions notes scaps/],
3621                 "sdist" => [qw/streams notes/],
3622                 "sstr" => ["routing_list_users"]
3623             }
3624         }
3625     ]) or return $e->die_event;
3626
3627     # ADMIN_SERIAL_SUBSCRIPTION will have to be good enough as a
3628     # catch-all permisison for this operation.
3629     return $e->die_event unless
3630         $e->allowed("ADMIN_SERIAL_SUBSCRIPTION", $sub->owning_lib);
3631
3632     my $result = _clone_subscription($sub, $bib_id, $e);
3633
3634     return $e->die_event($result) if $U->event_code($result);
3635
3636     $e->commit or return $e->die_event;
3637     return $result;
3638 }
3639
3640 1;