lib/NCIP/ILS/Evergreen.pm

   1 # ---------------------------------------------------------------
   2 # Copyright © 2014 Jason J.A. Stephenson <jason@sigio.com>
   3 #
   4 # This file is part of NCIPServer.
   5 #
   6 # NCIPServer is free software; you can redistribute it and/or modify
   7 # it under the terms of the GNU General Public License as published by
   8 # the Free Software Foundation; either version 2 of the License, or
   9 # (at your option) any later version.
  10 #
  11 # NCIPServer is distributed in the hope that it will be useful, but
  12 # WITHOUT ANY WARRANTY; without even the implied warranty of
  13 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  14 # General Public License for more details.
  15 #
  16 # You should have received a copy of the GNU General Public License
  17 # along with NCIPServer.  If not, see <http://www.gnu.org/licenses/>.
  18 # ---------------------------------------------------------------
  19 package NCIP::ILS::Evergreen;
  20
  21 use Modern::Perl;
  22 use XML::LibXML::Simple qw(XMLin);
  23 use DateTime;
  24 use DateTime::Format::ISO8601;
  25 use Digest::MD5 qw/md5_hex/;
  26 use OpenSRF::System;
  27 use OpenSRF::AppSession;
  28 use OpenSRF::Utils qw/:datetime/;
  29 use OpenSRF::Utils::SettingsClient;
  30 use OpenILS::Utils::Fieldmapper;
  31 use OpenILS::Utils::Normalize qw(clean_marc);
  32 use OpenILS::Application::AppUtils;
  33 use OpenILS::Const qw/:const/;
  34 use MARC::Record;
  35 use MARC::Field;
  36 use MARC::File::XML;
  37 use List::MoreUtils qw/uniq/;
  38 use POSIX qw/strftime/;
  39
  40 # We need a bunch of NCIP::* objects.
  41 use NCIP::Response;
  42 use NCIP::Problem;
  43 use NCIP::User;
  44 use NCIP::User::OptionalFields;
  45 use NCIP::User::AddressInformation;
  46 use NCIP::User::Id;
  47 use NCIP::User::BlockOrTrap;
  48 use NCIP::User::Privilege;
  49 use NCIP::User::PrivilegeStatus;
  50 use NCIP::StructuredPersonalUserName;
  51 use NCIP::StructuredAddress;
  52 use NCIP::ElectronicAddress;
  53 use NCIP::PhysicalAddress;
  54 use NCIP::RequestId;
  55 use NCIP::Item::Id;
  56 use NCIP::Item::OptionalFields;
  57 use NCIP::Item::BibliographicDescription;
  58 use NCIP::Item::BibliographicItemId;
  59 use NCIP::Item::BibliographicRecordId;
  60 use NCIP::Item::Description;
  61
  62 # Inherit from NCIP::ILS.
  63 use parent qw(NCIP::ILS);
  64
  65 =head1 NAME
  66
  67 Evergreen - Evergreen driver for NCIPServer
  68
  69 =head1 SYNOPSIS
  70
  71     my $ils = NCIP::ILS::Evergreen->new(name => $config->{NCIP.ils.value});
  72
  73 =head1 DESCRIPTION
  74
  75 NCIP::ILS::Evergreen is the default driver for Evergreen and
  76 NCIPServer. It was initially developed to work with Auto-Graphics'
  77 SHAREit software using a subset of an unspecified ILL/DCB profile.
  78
  79 =cut
  80
  81 # Default values we define for things that might be missing in our
  82 # runtime environment or configuration file that absolutely must have
  83 # values.
  84 #
  85 # OILS_NCIP_CONFIG_DEFAULT is the default location to find our
  86 # driver's configuration file.  This location can be overridden by
  87 # setting the path in the OILS_NCIP_CONFIG environment variable.
  88 #
  89 # BIB_SOURCE_DEFAULT is the config.bib_source.id to use when creating
  90 # "short" bibs.  It is used only if no entry is supplied in the
  91 # configuration file.  The provided default is 2, the id of the
  92 # "System Local" source that comes with a default Evergreen
  93 # installation.
  94 use constant {
  95     OILS_NCIP_CONFIG_DEFAULT => '/openils/conf/oils_ncip.xml',
  96     BIB_SOURCE_DEFAULT => 2
  97 };
  98
  99 # A common Evergreen code shortcut to use AppUtils:
 100 my $U = 'OpenILS::Application::AppUtils';
 101
 102 # The usual constructor:
 103 sub new {
 104     my $class = shift;
 105     $class = ref($class) if (ref $class);
 106
 107     # Instantiate our parent with the rest of the arguments.  It
 108     # creates a blessed hashref.
 109     my $self = $class->SUPER::new(@_);
 110
 111     # Look for our configuration file, load, and parse it:
 112     $self->_configure();
 113
 114     # Bootstrap OpenSRF and prepare some OpenILS components.
 115     $self->_bootstrap();
 116
 117     # Initialize the rest of our internal state.
 118     $self->_init();
 119
 120     return $self;
 121 }
 122
 123 =head1 HANDLER METHODS
 124
 125 =head2 lookupuser
 126
 127     $ils->lookupuser($request);
 128
 129 Processes a LookupUser request.
 130
 131 =cut
 132
 133 sub lookupuser {
 134     my $self = shift;
 135     my $request = shift;
 136
 137     # Check our session and login if necessary.
 138     $self->login() unless ($self->checkauth());
 139
 140     my $message_type = $self->parse_request_type($request);
 141
 142     # Let's go ahead and create our response object. We need this even
 143     # if there is a problem.
 144     my $response = NCIP::Response->new({type => $message_type . "Response"});
 145     $response->header($self->make_header($request));
 146
 147     # Need to parse the request object to get the user barcode.
 148     my ($barcode, $idfield) = $self->find_user_barcode($request);
 149
 150     # If we did not find a barcode, then report the problem.
 151     if (ref($barcode) eq 'NCIP::Problem') {
 152         $response->problem($barcode);
 153         return $response;
 154     }
 155
 156     # Look up our patron by barcode:
 157     my $user = $self->retrieve_user_by_barcode($barcode, $idfield);
 158     if (ref($user) eq 'NCIP::Problem') {
 159         $response->problem($user);
 160         return $response;
 161     }
 162
 163     # We got the information, so lets fill in our userdata.
 164     my $userdata = NCIP::User->new();
 165
 166     # Use the user's main card as the UserId.
 167     my $id = NCIP::User::Id->new({
 168         UserIdentifierType => 'Barcode',
 169         UserIdentifierValue => $user->card->barcode() || $barcode
 170     });
 171     $userdata->UserId($id);
 172
 173     # Check if they requested any optional fields and return those.
 174     my $elements = $request->{$message_type}->{UserElementType};
 175     if ($elements) {
 176         $elements = [$elements] unless (ref $elements eq 'ARRAY');
 177         my $optionalfields = $self->handle_user_elements($user, $elements);
 178         $userdata->UserOptionalFields($optionalfields);
 179     }
 180
 181     $response->data($userdata);
 182
 183     return $response;
 184 }
 185
 186 =head2 acceptitem
 187
 188     $ils->acceptitem($request);
 189
 190 Processes an AcceptItem request.
 191
 192 =cut
 193
 194 sub acceptitem {
 195     my $self = shift;
 196     my $request = shift;
 197
 198     # Check our session and login if necessary.
 199     $self->login() unless ($self->checkauth());
 200
 201     # Common preparation.
 202     my $message = $self->parse_request_type($request);
 203     my $response = NCIP::Response->new({type => $message . 'Response'});
 204     $response->header($self->make_header($request));
 205
 206     # We only accept holds for the time being.
 207     if ($request->{$message}->{RequestedActionType} =~ /^hold\W/i) {
 208         # We need the item id or we can't do anything at all.
 209         my ($item_barcode, $item_idfield) = $self->find_item_barcode($request);
 210         if (ref($item_barcode) eq 'NCIP::Problem') {
 211             $response->problem($item_barcode);
 212             return $response;
 213         }
 214
 215         # We need to find a patron barcode or we can't look anyone up
 216         # to place a hold.
 217         my ($user_barcode, $user_idfield) = $self->find_user_barcode($request, 'UserIdentifierValue');
 218         if (ref($user_barcode) eq 'NCIP::Problem') {
 219             $response->problem($user_barcode);
 220             return $response;
 221         }
 222         # Look up our patron by barcode:
 223         my $user = $self->retrieve_user_by_barcode($user_barcode, $user_idfield);
 224         if (ref($user) eq 'NCIP::Problem') {
 225             $response->problem($user);
 226             return $response;
 227         }
 228         # We're doing patron checks before looking for bibliographic
 229         # information and creating the item because problems with the
 230         # patron are more likely to occur.
 231         my $problem = $self->check_user_for_problems($user, 'HOLD');
 232         if ($problem) {
 233             $response->problem($problem);
 234             return $response;
 235         }
 236
 237         # Check if the item barcode already exists:
 238         my $item = $self->retrieve_copy_details_by_barcode($item_barcode);
 239         if ($item) {
 240             # What to do here was not defined in the
 241             # specification. Since the copies that we create this way
 242             # should get deleted when checked in, it would be an error
 243             # if we try to create another one. It means that something
 244             # has gone wrong somewhere.
 245             $response->problem(
 246                 NCIP::Problem->new(
 247                     {
 248                         ProblemType => 'Duplicate Item',
 249                         ProblemDetail => "Item with barcode $item_barcode already exists.",
 250                         ProblemElement => $item_idfield,
 251                         ProblemValue => $item_barcode
 252                     }
 253                 )
 254             );
 255             return $response;
 256         }
 257
 258         # Now, we have to create our new copy and/or bib and call number.
 259
 260         # First, we have to gather the necessary information from the
 261         # request.  Store in a hashref for convenience. We may write a
 262         # method to get this information in the future if we find we
 263         # need it in other handlers. Such a function would be a
 264         # candidate to go into our parent, NCIP::ILS.
 265         my $item_info = {
 266             barcode => $item_barcode,
 267             call_number => $request->{$message}->{ItemOptionalFields}->{ItemDescription}->{CallNumber},
 268             title => $request->{$message}->{ItemOptionalFields}->{BibliographicDescription}->{Title},
 269             author => $request->{$message}->{ItemOptionalFields}->{BibliographicDescription}->{Author},
 270             publisher => $request->{$message}->{ItemOptionalFields}->{BibliographicDescription}->{Publisher},
 271             publication_date => $request->{$message}->{ItemOptionalFields}->{BibliographicDescription}->{PublicationDate},
 272             medium => $request->{$message}->{ItemOptionalFields}->{BibliographicDescription}->{MediumType},
 273             electronic => $request->{$message}->{ItemOptionalFields}->{BibliographicDescription}->{ElectronicResource}
 274         };
 275
 276         if ($self->{config}->{items}->{use_precats}) {
 277             # We only need to create a precat copy.
 278             $item = $self->create_precat_copy($item_info);
 279         } else {
 280             # We have to create a "partial" bib record, a call number and a copy.
 281             $item = $self->create_fuller_copy($item_info);
 282         }
 283
 284         # If we failed to create the copy, report a problem.
 285         unless ($item) {
 286             $response->problem(
 287                 {
 288                     ProblemType => 'Temporary Processing Failure',
 289                     ProblemDetail => 'Failed to create the item in the system',
 290                     ProblemElement => $item_idfield,
 291                     ProblemValue => $item_barcode
 292                 }
 293             );
 294             return $response;
 295         }
 296
 297         # We try to find the pickup location in our database. It's OK
 298         # if it does not exist, the user's home library will be used
 299         # instead.
 300         my $location = $self->find_location_failover($request->{$message}->{PickupLocation}, $request, $message);
 301
 302         # Now, we place the hold on the newly created copy on behalf
 303         # of the patron retrieved above.
 304         my $hold = $self->place_hold($item, $user, $location);
 305         if (ref($hold) eq 'NCIP::Problem') {
 306             $response->problem($hold);
 307             return $response;
 308         }
 309
 310         # We return the RequestId and optionally, the ItemID. We'll
 311         # just return what was sent to us, since we ignored all of it
 312         # but the barcode.
 313         my $data = {};
 314         $data->{RequestId} = NCIP::RequestId->new(
 315             {
 316                 AgencyId => $request->{$message}->{RequestId}->{AgencyId},
 317                 RequestIdentifierType => $request->{$message}->{RequestId}->{RequestIdentifierType},
 318                 RequestIdentifierValue => $request->{$message}->{RequestId}->{RequestIdentifierValue}
 319             }
 320         );
 321         $data->{ItemId} = NCIP::Item::Id->new(
 322             {
 323                 AgencyId => $request->{$message}->{ItemId}->{AgencyId},
 324                 ItemIdentifierType => $request->{$message}->{ItemId}->{ItemIdentifierType},
 325                 ItemIdentifierValue => $request->{$message}->{ItemId}->{ItemIdentifierValue}
 326             }
 327         );
 328         $response->data($data);
 329
 330     } else {
 331         my $problem = NCIP::Problem->new();
 332         $problem->ProblemType('Unauthorized Combination Of Element Values For System');
 333         $problem->ProblemDetail('We only support Hold For Pickup');
 334         $problem->ProblemElement('RequestedActionType');
 335         $problem->ProblemValue($request->{$message}->{RequestedActionType});
 336         $response->problem($problem);
 337     }
 338
 339     return $response;
 340 }
 341
 342 =head2 checkinitem
 343
 344     $response = $ils->checkinitem($request);
 345
 346 Checks the item in if we can find the barcode in the message. It
 347 returns problems if it cannot find the item in the system or if the
 348 item is not checked out.
 349
 350 It could definitely use some more brains at some point as it does not
 351 fully support everything that the standard allows. It also does not
 352 really check if the checkin succeeded or not.
 353
 354 =cut
 355
 356 sub checkinitem {
 357     my $self = shift;
 358     my $request = shift;
 359
 360     # Check our session and login if necessary:
 361     $self->login() unless ($self->checkauth());
 362
 363     # Common stuff:
 364     my $message = $self->parse_request_type($request);
 365     my $response = NCIP::Response->new({type => $message . 'Response'});
 366     $response->header($self->make_header($request));
 367
 368     # We need the copy barcode from the message.
 369     my ($item_barcode, $item_idfield) = $self->find_item_barcode($request);
 370     if (ref($item_barcode) eq 'NCIP::Problem') {
 371         $response->problem($item_barcode);
 372         return $response;
 373     }
 374
 375     # Retrieve the copy details.
 376     my $details = $self->retrieve_copy_details_by_barcode($item_barcode);
 377     unless ($details) {
 378         # Return an Unknown Item problem unless we find the copy.
 379         $response->problem(
 380             NCIP::Problem->new(
 381                 {
 382                     ProblemType => 'Unknown Item',
 383                     ProblemDetail => "Item with barcode $item_barcode is not known.",
 384                     ProblemElement => $item_idfield,
 385                     ProblemValue => $item_barcode
 386                 }
 387             )
 388         );
 389         return $response;
 390     }
 391
 392     # Check if a UserId was provided. If so, this is the patron to
 393     # whom the copy should be checked out.
 394     my $user;
 395     my ($user_barcode, $user_idfield) = $self->find_user_barcode($request);
 396     # We ignore the problem, because the UserId is optional.
 397     if (ref($user_barcode) ne 'NCIP::Problem') {
 398         $user = $self->retrieve_user_by_barcode($user_barcode, $user_idfield);
 399         # We don't ignore a problem here, however.
 400         if (ref($user) eq 'NCIP::Problem') {
 401             $response->problem($user);
 402             return $response;
 403         }
 404     }
 405
 406     # Isolate the copy.
 407     my $copy = $details->{copy};
 408
 409     # Look for a circulation and examine its information:
 410     my $circ = $details->{circ};
 411
 412     # Check the circ details to see if the copy is checked out and, if
 413     # the patron was provided, that it is checked out to the patron in
 414     # question. We also verify the copy ownership and circulation
 415     # location.
 416     my $problem = $self->check_circ_details($circ, $copy, $user);
 417     if ($problem) {
 418         # We need to fill in some information, however.
 419         if (!$problem->ProblemValue() && !$problem->ProblemElement()) {
 420             $problem->ProblemValue($user_barcode);
 421             $problem->ProblemElement($user_idfield);
 422         } elsif (!$problem->ProblemElement()) {
 423             $problem->ProblemElement($item_idfield);
 424         }
 425         $response->problem($problem);
 426         return $response;
 427     }
 428
 429     # Checkin parameters. We want to skip hold targeting or making
 430     # transits, to force the checkin despite the copy status, as
 431     # well as void overdues.
 432     my $params = {
 433         copy_barcode => $copy->barcode(),
 434         force => 1,
 435         noop => 1,
 436         void_overdues => 1
 437     };
 438     my $result = $U->simplereq(
 439         'open-ils.circ',
 440         'open-ils.circ.checkin.override',
 441         $self->{session}->{authtoken},
 442         $params
 443     );
 444     if (ref($result) eq 'ARRAY') {
 445         $result = $result->[0];
 446     }
 447     if ($result->{textcode} eq 'SUCCESS') {
 448         # Delete the copy. Since delete_copy checks ownership
 449         # before attempting to delete the copy, we don't bother
 450         # checking who owns it.
 451         $self->delete_copy($copy);
 452         # We need the circulation user for the information below, so we retrieve it.
 453         my $circ_user = $self->retrieve_user_by_id($circ->usr());
 454         my $data = {
 455             ItemId => NCIP::Item::Id->new(
 456                 {
 457                     AgencyId => $request->{$message}->{ItemId}->{AgencyId},
 458                     ItemIdentifierType => $request->{$message}->{ItemId}->{ItemIdentifierType},
 459                     ItemIdentifierValue => $request->{$message}->{ItemId}->{ItemIdentifierValue}
 460                 }
 461             ),
 462             UserId => NCIP::User::Id->new(
 463                 {
 464                     UserIdentifierType => 'Barcode Id',
 465                     UserIdentifierValue => $circ_user->card->barcode()
 466                 }
 467             )
 468         };
 469
 470         # Look for UserElements requested and add it to the response:
 471         my $elements = $request->{$message}->{UserElementType};
 472         if ($elements) {
 473             $elements = [$elements] unless (ref $elements eq 'ARRAY');
 474             my $optionalfields = $self->handle_user_elements($circ_user, $elements);
 475             $data->{UserOptionalFields} = $optionalfields;
 476         }
 477         $elements = $request->{$message}->{ItemElementType};
 478         if ($elements) {
 479             $elements = [$elements] unless (ref $elements eq 'ARRAY');
 480             my $optionalfields = $self->handle_item_elements($copy, $elements);
 481             $data->{ItemOptionalFields} = $optionalfields;
 482         }
 483
 484         $response->data($data);
 485
 486         # At some point in the future, we should probably check if
 487         # they requested optional user or item elements and return
 488         # those. For the time being, we ignore those at the risk of
 489         # being considered non-compliant.
 490     } else {
 491         $response->problem(_problem_from_event('Checkin Failed', $result));
 492     }
 493
 494     return $response
 495 }
 496
 497 =head2 renewitem
 498
 499     $response = $ils->renewitem($request);
 500
 501 Handle the RenewItem message.
 502
 503 =cut
 504
 505 sub renewitem {
 506     my $self = shift;
 507     my $request = shift;
 508
 509     # Check our session and login if necessary:
 510     $self->login() unless ($self->checkauth());
 511
 512     # Common stuff:
 513     my $message = $self->parse_request_type($request);
 514     my $response = NCIP::Response->new({type => $message . 'Response'});
 515     $response->header($self->make_header($request));
 516
 517     # We need the copy barcode from the message.
 518     my ($item_barcode, $item_idfield) = $self->find_item_barcode($request);
 519     if (ref($item_barcode) eq 'NCIP::Problem') {
 520         $response->problem($item_barcode);
 521         return $response;
 522     }
 523
 524     # Retrieve the copy details.
 525     my $details = $self->retrieve_copy_details_by_barcode($item_barcode);
 526     unless ($details) {
 527         # Return an Unknown Item problem unless we find the copy.
 528         $response->problem(
 529             NCIP::Problem->new(
 530                 {
 531                     ProblemType => 'Unknown Item',
 532                     ProblemDetail => "Item with barcode $item_barcode is not known.",
 533                     ProblemElement => $item_idfield,
 534                     ProblemValue => $item_barcode
 535                 }
 536             )
 537         );
 538         return $response;
 539     }
 540
 541     # User is required for RenewItem.
 542     my ($user_barcode, $user_idfield) = $self->find_user_barcode($request);
 543     if (ref($user_barcode) eq 'NCIP::Problem') {
 544         $response->problem($user_barcode);
 545         return $response;
 546     }
 547     my $user = $self->retrieve_user_by_barcode($user_barcode, $user_idfield);
 548     if (ref($user) eq 'NCIP::Problem') {
 549         $response->problem($user);
 550         return $response;
 551     }
 552
 553     # Isolate the copy.
 554     my $copy = $details->{copy};
 555
 556     # Look for a circulation and examine its information:
 557     my $circ = $details->{circ};
 558
 559     # Check the circ details to see if the copy is checked out and, if
 560     # the patron was provided, that it is checked out to the patron in
 561     # question. We also verify the copy ownership and circulation
 562     # location.
 563     my $problem = $self->check_circ_details($circ, $copy, $user);
 564     if ($problem) {
 565         # We need to fill in some information, however.
 566         if (!$problem->ProblemValue() && !$problem->ProblemElement()) {
 567             $problem->ProblemValue($user_barcode);
 568             $problem->ProblemElement($user_idfield);
 569         } elsif (!$problem->ProblemElement()) {
 570             $problem->ProblemElement($item_idfield);
 571         }
 572         $response->problem($problem);
 573         return $response;
 574     }
 575
 576     # Check if user is blocked from renewals:
 577     $problem = $self->check_user_for_problems($user, 'RENEW');
 578     if ($problem) {
 579         # Replace the ProblemElement and ProblemValue fields.
 580         $problem->ProblemElement($user_idfield);
 581         $problem->ProblemValue($user_barcode);
 582         $response->problem($problem);
 583         return $response;
 584     }
 585
 586     # Check if the duration rule allows renewals. It should have been
 587     # fleshed during the copy details retrieve.
 588     my $rule = $circ->duration_rule();
 589     unless (ref($rule)) {
 590         $rule = $U->simplereq(
 591             'open-ils.pcrud',
 592             'open-ils.pcrud.retrieve.crcd',
 593             $self->{session}->{authtoken},
 594             $rule
 595         )->gather(1);
 596     }
 597     if ($rule->max_renewals() < 1) {
 598         $response->problem(
 599             NCIP::Problem->new(
 600                 {
 601                     ProblemType => 'Item Not Renewable',
 602                     ProblemDetail => 'Item may not be renewed.',
 603                     ProblemElement => $item_idfield,
 604                     ProblemValue => $item_barcode
 605                 }
 606             )
 607         );
 608         return $response;
 609     }
 610
 611     # Check if there are renewals remaining on the latest circ:
 612     if ($circ->renewal_remaining() < 1) {
 613         $response->problem(
 614             NCIP::Problem->new(
 615                 {
 616                     ProblemType => 'Maximum Renewals Exceeded',
 617                     ProblemDetail => 'Renewal cannot proceed because the User has already renewed the Item the maximum number of times permitted.',
 618                     ProblemElement => $item_idfield,
 619                     ProblemValue => $item_barcode
 620                 }
 621             )
 622         );
 623         return $response;
 624     }
 625
 626     # Now, we attempt the renewal. If it fails, we simply say that the
 627     # user is not allowed to renew this item, without getting into
 628     # details.
 629     my $params = {
 630         copy_id => $copy->id(),
 631         patron_id => $user->id(),
 632         sip_renewal => 1
 633     };
 634     my $r = $U->simplereq(
 635         'open-ils.circ',
 636         'open-ils.circ.renew.override',
 637         $self->{session}->{authtoken},
 638         $params
 639     )->gather(1);
 640
 641     # We only look at the first one, since more than one usually means
 642     # failure.
 643     if (ref($r) eq 'ARRAY') {
 644         $r = $r->[0];
 645     }
 646     if ($r->{textcode} ne 'SUCCESS') {
 647         $problem = _problem_from_event('Renewal Failed', $r);
 648         $response->problem($problem);
 649     } else {
 650         my $data = {
 651             ItemId => NCIP::Item::Id->new(
 652                 {
 653                     AgencyId => $request->{$message}->{ItemId}->{AgencyId},
 654                     ItemIdentifierType => $request->{$message}->{ItemId}->{ItemIdentifierType},
 655                     ItemIdentifierValue => $request->{$message}->{ItemId}->{ItemIdentifierValue}
 656                 }
 657             ),
 658             UserId => NCIP::User::Id->new(
 659                 {
 660                     UserIdentifierType => 'Barcode Id',
 661                     UserIdentifierValue => $user->card->barcode()
 662                 }
 663             )
 664         };
 665         # We need to retrieve the copy details again to refresh our
 666         # circ information to get the new due date.
 667         $details = $self->retrieve_copy_details_by_barcode($item_barcode);
 668         $circ = $details->{circ};
 669         $data->{DateDue} = _fix_date($circ->due_date());
 670
 671         # Look for UserElements requested and add it to the response:
 672         my $elements = $request->{$message}->{UserElementType};
 673         if ($elements) {
 674             $elements = [$elements] unless (ref $elements eq 'ARRAY');
 675             my $optionalfields = $self->handle_user_elements($user, $elements);
 676             $data->{UserOptionalFields} = $optionalfields;
 677         }
 678         $elements = $request->{$message}->{ItemElementType};
 679         if ($elements) {
 680             $elements = [$elements] unless (ref $elements eq 'ARRAY');
 681             my $optionalfields = $self->handle_item_elements($details->{copy}, $elements);
 682             $data->{ItemOptionalFields} = $optionalfields;
 683         }
 684
 685         $response->data($data);
 686     }
 687
 688     # At some point in the future, we should probably check if
 689     # they requested optional user or item elements and return
 690     # those. For the time being, we ignore those at the risk of
 691     # being considered non-compliant.
 692
 693     return $response;
 694 }
 695
 696 =head2 checkoutitem
 697
 698     $response = $ils->checkoutitem($request);
 699
 700 Handle the Checkoutitem message.
 701
 702 =cut
 703
 704 sub checkoutitem {
 705     my $self = shift;
 706     my $request = shift;
 707
 708     # Check our session and login if necessary:
 709     $self->login() unless ($self->checkauth());
 710
 711     # Common stuff:
 712     my $message = $self->parse_request_type($request);
 713     my $response = NCIP::Response->new({type => $message . 'Response'});
 714     $response->header($self->make_header($request));
 715
 716     # We need the copy barcode from the message.
 717     my ($item_barcode, $item_idfield) = $self->find_item_barcode($request);
 718     if (ref($item_barcode) eq 'NCIP::Problem') {
 719         $response->problem($item_barcode);
 720         return $response;
 721     }
 722
 723     # Retrieve the copy details.
 724     my $details = $self->retrieve_copy_details_by_barcode($item_barcode);
 725     unless ($details) {
 726         # Return an Unknown Item problem unless we find the copy.
 727         $response->problem(
 728             NCIP::Problem->new(
 729                 {
 730                     ProblemType => 'Unknown Item',
 731                     ProblemDetail => "Item with barcode $item_barcode is not known.",
 732                     ProblemElement => $item_idfield,
 733                     ProblemValue => $item_barcode
 734                 }
 735             )
 736         );
 737         return $response;
 738     }
 739
 740     # User is required for CheckOutItem.
 741     my ($user_barcode, $user_idfield) = $self->find_user_barcode($request);
 742     if (ref($user_barcode) eq 'NCIP::Problem') {
 743         $response->problem($user_barcode);
 744         return $response;
 745     }
 746     my $user = $self->retrieve_user_by_barcode($user_barcode, $user_idfield);
 747     if (ref($user) eq 'NCIP::Problem') {
 748         $response->problem($user);
 749         return $response;
 750     }
 751
 752     # Isolate the copy.
 753     my $copy = $details->{copy};
 754
 755     # Check if the copy can circulate.
 756     unless ($self->copy_can_circulate($copy)) {
 757         $response->problem(
 758             NCIP::Problem->new(
 759                 {
 760                     ProblemType => 'Item Does Not Circulate',
 761                     ProblemDetail => "Item with barcode $item_barcode does not circulate.",
 762                     ProblemElement => $item_idfield,
 763                     ProblemValue => $item_barcode
 764                 }
 765             )
 766         );
 767         return $response;
 768     }
 769
 770     # Look for a circulation and examine its information:
 771     my $circ = $details->{circ};
 772
 773     # Check if the item is already checked out.
 774     if ($circ && !$circ->checkin_time()) {
 775         $response->problem(
 776             NCIP::Problem->new(
 777                 {
 778                     ProblemType => 'Item Already Checked Out',
 779                     ProblemDetail => "Item with barcode $item_barcode is already checked out.",
 780                     ProblemElement => $item_idfield,
 781                     ProblemValue => $item_barcode
 782                 }
 783             )
 784         );
 785         return $response;
 786     }
 787
 788     # Check if user is blocked from circulation:
 789     my $problem = $self->check_user_for_problems($user, 'CIRC');
 790     if ($problem) {
 791         # Replace the ProblemElement and ProblemValue fields.
 792         $problem->ProblemElement($user_idfield);
 793         $problem->ProblemValue($user_barcode);
 794         $response->problem($problem);
 795         return $response;
 796     }
 797
 798     # Check for the copy being in transit and receive or abort it.
 799     my $transit = $U->simplereq(
 800         'open-ils.circ',
 801         'open-ils.circ.open_copy_transit.retrieve',
 802         $self->{session}->{authtoken},
 803         $copy->id()
 804     );
 805     if (ref($transit) eq 'Fieldmapper::action::transit_copy') {
 806         if ($transit->dest() == $self->{session}->{work_ou}->id()) {
 807             my $r = $U->simplereq(
 808                 'open-ils.circ',
 809                 'open-ils.circ.copy_transit.receive',
 810                 $self->{session}->{authtoken},
 811                 {copyid => $copy->id()}
 812             );
 813         } elsif ($transit->source() == $self->{session}->{work_ou}->id()) {
 814             my $r = $U->simplereq(
 815                 'open-ils.circ',
 816                 'open-ils.circ.transit.abort',
 817                 $self->{session}->{authtoken},
 818                 {copyid => $copy->id()}
 819             );
 820         }
 821     }
 822
 823     # Now, we attempt the check out. If it fails, we simply say that
 824     # the user is not allowed to check out this item, without getting
 825     # into details.
 826     my $params = {
 827         copy_id => $copy->id(),
 828         patron_id => $user->id(),
 829     };
 830     my $r = $U->simplereq(
 831         'open-ils.circ',
 832         'open-ils.circ.checkout.full.override',
 833         $self->{session}->{authtoken},
 834         $params
 835     );
 836
 837     # We only look at the first one, since more than one usually means
 838     # failure.
 839     if (ref($r) eq 'ARRAY') {
 840         $r = $r->[0];
 841     }
 842     if ($r->{textcode} ne 'SUCCESS') {
 843         $problem = _problem_from_event('Check Out Failed', $r);
 844         $response->problem($problem);
 845     } else {
 846         my $data = {
 847             ItemId => NCIP::Item::Id->new(
 848                 {
 849                     AgencyId => $request->{$message}->{ItemId}->{AgencyId},
 850                     ItemIdentifierType => $request->{$message}->{ItemId}->{ItemIdentifierType},
 851                     ItemIdentifierValue => $request->{$message}->{ItemId}->{ItemIdentifierValue}
 852                 }
 853             ),
 854             UserId => NCIP::User::Id->new(
 855                 {
 856                     UserIdentifierType => 'Barcode Id',
 857                     UserIdentifierValue => $user->card->barcode()
 858                 }
 859             )
 860         };
 861         # We need to retrieve the copy details again to refresh our
 862         # circ information to get the due date.
 863         $details = $self->retrieve_copy_details_by_barcode($item_barcode);
 864         $circ = $details->{circ};
 865         $data->{DateDue} = _fix_date($circ->due_date());
 866
 867         # Look for UserElements requested and add it to the response:
 868         my $elements = $request->{$message}->{UserElementType};
 869         if ($elements) {
 870             $elements = [$elements] unless (ref $elements eq 'ARRAY');
 871             my $optionalfields = $self->handle_user_elements($user, $elements);
 872             $data->{UserOptionalFields} = $optionalfields;
 873         }
 874         $elements = $request->{$message}->{ItemElementType};
 875         if ($elements) {
 876             $elements = [$elements] unless (ref $elements eq 'ARRAY');
 877             my $optionalfields = $self->handle_item_elements($details->{copy}, $elements);
 878             $data->{ItemOptionalFields} = $optionalfields;
 879         }
 880
 881         $response->data($data);
 882     }
 883
 884     # At some point in the future, we should probably check if
 885     # they requested optional user or item elements and return
 886     # those. For the time being, we ignore those at the risk of
 887     # being considered non-compliant.
 888
 889     return $response;
 890 }
 891
 892 =head2 requestitem
 893
 894     $response = $ils->requestitem($request);
 895
 896 Handle the NCIP RequestItem message.
 897
 898 =cut
 899
 900 sub requestitem {
 901     my $self = shift;
 902     my $request = shift;
 903     # Check our session and login if necessary:
 904     $self->login() unless ($self->checkauth());
 905
 906     # Common stuff:
 907     my $message = $self->parse_request_type($request);
 908     my $response = NCIP::Response->new({type => $message . 'Response'});
 909     $response->header($self->make_header($request));
 910
 911     # We originally had a mass of complicated code here to handle most
 912     # of the possibilities provided by the standard.  However, that
 913     # proved too difficult to get working with what we've agreed to do
 914     # with Auto-Graphics.  The response was supposed to include the
 915     # ItemId, and for some reason that I couldn't figure out it was
 916     # not there.  In order to get this working, I've decided to ignor
 917     # the extra stuff in the standard and just go with what our
 918     # current vendor sends.
 919
 920     # Because we need to have a user to place a hold, because the user
 921     # is likely to have problems, and because getting the item
 922     # information for the hold is trickier than getting the user
 923     # information, we'll do the user first and short circuit out of
 924     # the function if there is a problem with the user.
 925     my ($user_barcode, $user_idfield) = $self->find_user_barcode($request);
 926     if (ref($user_barcode) eq 'NCIP::Problem') {
 927         $response->problem($user_barcode);
 928         return $response;
 929     }
 930     my $user = $self->retrieve_user_by_barcode($user_barcode, $user_idfield);
 931     if (ref($user) eq 'NCIP::Problem') {
 932         $response->problem($user);
 933         return $response;
 934     }
 935     my $problem = $self->check_user_for_problems($user, 'HOLD');
 936     if ($problem) {
 937         $response->problem($problem);
 938         return $response;
 939     }
 940
 941     # Auto-Graphics send a single BibliographicRecordId to identify
 942     # the "item" to place on hold.
 943     my $bibid;
 944     if ($request->{$message}->{BibliographicId}) {
 945         my $idxml = $request->{$message}->{BibliographicId};
 946         # The standard allows more than 1.  If that hapens, we only
 947         # use the first.
 948         $idxml = $idxml->[0] if (ref($idxml) eq 'ARRAY');
 949         if ($idxml->{BibliographicRecordId}) {
 950             $bibid = NCIP::Item::BibliographicRecordId->new(
 951                 $idxml->{BibliographicRecordId}
 952             );
 953         }
 954     }
 955     unless ($bibid && $bibid->{BibliographicRecordIdentifier}) {
 956         $problem = NCIP::Problem->new(
 957             {
 958                 ProblemType => 'Needed Data Missing',
 959                 ProblemDetail => 'Need BibliographicRecordIdentifier to place request',
 960                 ProblemElement => 'BibliographicRecordIdentifier',
 961                 ProblemValue => 'NULL'
 962             }
 963         );
 964         $response->problem($problem);
 965         return $response;
 966     }
 967
 968     # We need an actual bre.
 969     my $bre = $self->retrieve_biblio_record_entry($bibid->{BibliographicRecordIdentifier});
 970     if (!$bre || $U->is_true($bre->deleted())) {
 971         $problem = NCIP::Problem->new(
 972             {
 973                 ProblemType => 'Unknown Item',
 974                 ProblemDetail => 'Item ' . $bibid->{BibliographicRecordIdentifier} . ' is unknown',
 975                 ProblemElement => 'BibliographicRecordIdentifier',
 976                 ProblemValue => $bibid->{BibliographicRecordIdentifier}
 977             }
 978         );
 979         $response->problem($problem);
 980         return $response;
 981     }
 982
 983     # Auto-Graphics expects us to limit the selection ou for the hold
 984     # to a given library.  We look fo that in the AgencyId of the
 985     # BibliographRecordId or in the ToAgencyId of the main message.
 986     my $selection_ou = $self->find_location_failover($bibid->{AgencyId}, $request, $message);
 987     unless ($selection_ou) {
 988         $problem = NCIP::Problem->new(
 989             {
 990                 ProblemType => 'Unknown Agency',
 991                 ProblemDetail => 'Agency is not known',
 992                 ProblemElement => 'BibliographicRecordIdentifier',
 993                 ProblemValue => $bibid->{AgencyId} || $request->{$message}->{InitiationHeader}->{ToAgencyId}->{AgencyId}
 994             }
 995         );
 996         $response->problem($problem);
 997         return $response;
 998     }
 999
1000     # We need to see if the bib exists and has a holdable, not deleted
1001     # copy at the selection_ou.  If successful, we retun a
1002     # copy_details hashref for the holdable copy.
1003     my $copy_details = $self->find_target_details_by_bre($bre, $selection_ou);
1004     unless ($copy_details) {
1005         # We don't know if the items do not circulate or are not
1006         # holdable, but the closest "standard" problem message is Item
1007         # Does Not Circulate.
1008         $problem = NCIP::Problem->new(
1009             {
1010                 ProblemType => 'Item Does Not Circulate',
1011                 ProblemDetail => 'Request of Item cannot proceed because the Item is non-circulating',
1012                 ProblemElement => 'BibliographicRecordIdentifier',
1013                 ProblemValue => $bre->id()
1014             }
1015         );
1016         $response->problem($problem);
1017         return $response;
1018     }
1019
1020     # See if we were given a pickup location.
1021     my $pickup_ou;
1022     if ($request->{$message}->{PickupLocation}) {
1023         my $loc = $request->{$message}->{PickupLocation};
1024         $loc =~ s/^.*://;
1025         $pickup_ou = $self->retrieve_org_unit_by_shortname($loc);
1026     }
1027
1028     # Look for a NeedBeforeDate to set the expiration.
1029     my $expiration = $request->{$message}->{NeedBeforeDate};
1030
1031     # Place the hold:
1032     my $hold = $self->place_hold($bre, $user, $pickup_ou, $expiration, $selection_ou);
1033     if (ref($hold) eq 'NCIP::Problem') {
1034         $response->problem($hold);
1035     } else {
1036         my $data = {
1037             RequestId => NCIP::RequestId->new(
1038                 $request->{$message}->{RequestId}
1039             ),
1040             ItemId => NCIP::Item::Id->new(
1041                 {
1042                     AgencyId => $selection_ou->shortname(),
1043                     ItemIdentifierValue => $bre->id(),
1044                     ItemIdentifierType => 'SYSNUMBER'
1045                 }
1046             ),
1047             UserId => NCIP::User::Id->new(
1048                 {
1049                     UserIdentifierValue => $user->card->barcode(),
1050                     UserIdentifierType => 'Barcode Id'
1051                 }
1052             ),
1053             RequestType => $request->{$message}->{RequestType},
1054             RequestScopeType => $request->{$message}->{RequestScopeType},
1055         };
1056
1057         # Look for UserElements requested and add it to the response:
1058         my $elements = $request->{$message}->{UserElementType};
1059         if ($elements) {
1060             $elements = [$elements] unless (ref $elements eq 'ARRAY');
1061             my $optionalfields = $self->handle_user_elements($user, $elements);
1062             $data->{UserOptionalFields} = $optionalfields;
1063         }
1064         $elements = $request->{$message}->{ItemElementType};
1065         if ($elements) {
1066             $elements = [$elements] unless (ref($elements) eq 'ARRAY');
1067             my $optionalfields = $self->handle_item_elements($copy_details->{copy}, $elements);
1068             $data->{ItemOptionalFields} = $optionalfields;
1069         }
1070
1071         $response->data($data);
1072     }
1073
1074     return $response;
1075 }
1076
1077 =head2 cancelrequestitem
1078
1079     $response = $ils->cancelrequestitem($request);
1080
1081 Handle the NCIP CancelRequestItem message.
1082
1083 =cut
1084
1085 sub cancelrequestitem {
1086     my $self = shift;
1087     my $request = shift;
1088     # Check our session and login if necessary:
1089     $self->login() unless ($self->checkauth());
1090
1091     # Common stuff:
1092     my $message = $self->parse_request_type($request);
1093     my $response = NCIP::Response->new({type => $message . 'Response'});
1094     $response->header($self->make_header($request));
1095
1096     # UserId is required by the standard, but we might not really need it.
1097     my ($user_barcode, $user_idfield) = $self->find_user_barcode($request);
1098     if (ref($user_barcode) eq 'NCIP::Problem') {
1099         $response->problem($user_barcode);
1100         return $response;
1101     }
1102     my $user = $self->retrieve_user_by_barcode($user_barcode, $user_idfield);
1103     if (ref($user) eq 'NCIP::Problem') {
1104         $response->problem($user);
1105         return $response;
1106     }
1107
1108     # Auto-Graphics has agreed to return the ItemId that we sent them
1109     # in the RequestItemResponse when they attempt CancelRequestItem
1110     # for that same request.  For the sake of time, we're only going
1111     # to support that method of looking up the hold request in
1112     # Evergreen.  We leave it as future enhancement to make this
1113     # "portable" to other vendors.  (Frankly, that's a fool's errand.
1114     # NCIP is one of those "standards" where you neeed a separate
1115     # implementation for every vendor.)
1116     my $item_id = $request->{$message}->{ItemId};
1117     unless ($item_id) {
1118         # We'll throw a problem that we're missing needed information.
1119         my $problem = NCIP::Problem->new();
1120         $problem->ProblemType('Needed Data Missing');
1121         $problem->ProblemDetail('Cannot find ItemId in message.');
1122         $problem->ProblemElement('ItemId');
1123         $problem->ProblemValue('NULL');
1124         $response->problem($problem);
1125         return $response;
1126     }
1127     my $idvalue = $item_id->{ItemIdentifierValue};
1128     my $itemagy = $item_id->{AgencyId};
1129     my $selection_ou = $self->find_location_failover($itemagy, $request, $message);
1130     unless ($selection_ou) {
1131         my $problem = NCIP::Problem->new(
1132             {
1133                 ProblemType => 'Unknown Agency',
1134                 ProblemDetail => 'Agency is not known',
1135                 ProblemElement => 'AgencyId',
1136                 ProblemValue => $item_id->{AgencyId} || $request->{$message}->{InitiationHeader}->{ToAgencyId}->{AgencyId}
1137             }
1138         );
1139         $response->problem($problem);
1140         return $response;
1141     }
1142
1143     # We should support looking up holds by barcode, since we still
1144     # support placing them by barcode, but that is not how it is going
1145     # to work with Auto-Graphics, apparently.  I'll leave the
1146     # reimplementation of that for a future enhancement.
1147
1148     # See if we can find the hold:
1149     my $hold = $self->_hold_search($user, $idvalue, $selection_ou);
1150     if ($hold && $hold->transit()) {
1151         $response->problem(
1152             NCIP::Problem->new(
1153                 {
1154                     ProblemType => 'Request Already Processed',
1155                     ProblemDetail => 'Request has already been processed',
1156                     ProblemElement => 'RequestIdentifierValue',
1157                     ProblemValue => $request->{message}->{RequestId}->{RequestIdentifierValue}
1158                 }
1159             )
1160        );
1161     } elsif ($hold) {
1162         my $result = $self->cancel_hold($hold);
1163         if (ref($result)) {
1164             $response->problem(_problem_from_event("Temporary Processing Failure", $result));
1165         } else {
1166             my $data = {
1167                 RequestId => NCIP::RequestId->new(
1168                     {
1169                         AgencyId => $request->{$message}->{RequestId}->{AgencyId},
1170                         RequestIdentifierType => $request->{$message}->{RequestId}->{RequestIdentifierType},
1171                         RequestIdentifierValue => $request->{$message}->{RequestId}->{RequestIdentifierValue}
1172                     }
1173                 ),
1174                 UserId => NCIP::User::Id->new(
1175                     {
1176                         UserIdentifierType => 'Barcode Id',
1177                         UserIdentifierValue => $user->card->barcode()
1178                     }
1179                 ),
1180                 ItemId => NCIP::Item::Id->new(
1181                     {
1182                         AgencyId => $request->{$message}->{ItemId}->{AgencyId},
1183                         ItemIdentifierType => $request->{$message}->{ItemId}->{ItemIdentifierType},
1184                         ItemIdentifierValue => $request->{$message}->{ItemId}->{ItemIdentifierValue}
1185                     }
1186                 )
1187             };
1188             # Look for UserElements requested and add it to the response:
1189             my $elements = $request->{$message}->{UserElementType};
1190             if ($elements) {
1191                 $elements = [$elements] unless (ref $elements eq 'ARRAY');
1192                 my $optionalfields = $self->handle_user_elements($user, $elements);
1193                 $data->{UserOptionalFields} = $optionalfields;
1194             }
1195             $elements = $request->{$message}->{ItemElementType};
1196             if ($elements && $hold->current_copy()) {
1197                 $elements = [$elements] unless (ref $elements eq 'ARRAY');
1198                 my $copy_details = $self->retrieve_copy_details_by_id($hold->current_copy());
1199                 if ($copy_details) {
1200                     my $optionalfields = $self->handle_item_elements($copy_details->{copy}, $elements);
1201                     $data->{ItemOptionalFields} = $optionalfields;
1202                 }
1203             }
1204             $response->data($data);
1205         }
1206     } else {
1207         $response->problem(
1208             NCIP::Problem->new(
1209                 {
1210                     ProblemType => 'Unknown Request',
1211                     ProblemDetail => 'No request found for the item and user',
1212                     ProblemElement => 'NULL',
1213                     ProblemValue => 'NULL'
1214                 }
1215             )
1216         )
1217     }
1218
1219     return $response;
1220 }
1221
1222 =head1 METHODS USEFUL to SUBCLASSES
1223
1224 =head2 handle_user_elements
1225     $useroptionalfield = $ils->handle_user_elements($user, $elements);
1226
1227 Returns NCIP::User::OptionalFields for the given user and arrayref of
1228 UserElement.
1229
1230 =cut
1231
1232 sub handle_user_elements {
1233     my $self = shift;
1234     my $user = shift;
1235     my $elements = shift;
1236     my $optionalfields = NCIP::User::OptionalFields->new();
1237
1238     # First, we'll look for name information.
1239     if (grep {$_ eq 'Name Information'} @$elements) {
1240         my $name = NCIP::StructuredPersonalUserName->new();
1241         $name->Surname($user->family_name());
1242         $name->GivenName($user->first_given_name());
1243         $name->Prefix($user->prefix());
1244         $name->Suffix($user->suffix());
1245         $optionalfields->NameInformation($name);
1246     }
1247
1248     # Next, check for user address information.
1249     if (grep {$_ eq 'User Address Information'} @$elements) {
1250         my $addresses = [];
1251
1252         # See if the user has any valid, physcial addresses.
1253         foreach my $addr (@{$user->addresses()}) {
1254             next if ($U->is_true($addr->pending()));
1255             my $address = NCIP::User::AddressInformation->new({UserAddressRoleType=>$addr->address_type()});
1256             my $structured = NCIP::StructuredAddress->new();
1257             $structured->Line1($addr->street1());
1258             $structured->Line2($addr->street2());
1259             $structured->Locality($addr->city());
1260             $structured->Region($addr->state());
1261             $structured->PostalCode($addr->post_code());
1262             $structured->Country($addr->country());
1263             $address->PhysicalAddress(
1264                 NCIP::PhysicalAddress->new(
1265                     {
1266                         StructuredAddress => $structured,
1267                         Type => 'Postal Address'
1268                     }
1269                 )
1270             );
1271             push @$addresses, $address;
1272         }
1273
1274         # Right now, we're only sharing email address if the user
1275         # has it.
1276         if ($user->email()) {
1277             my $address = NCIP::User::AddressInformation->new({UserAddressRoleType=>'Email Address'});
1278             $address->ElectronicAddress(
1279                 NCIP::ElectronicAddress->new({
1280                     Type=>'mailto',
1281                     Data=>$user->email()
1282                 })
1283                 );
1284             push @$addresses, $address;
1285         }
1286         # Auto-graphics asked for the phone numbers.
1287         if ($user->day_phone()) {
1288             my $address = NCIP::User::AddressInformation->new({UserAddressRoleType=>'Day Phone'});
1289             $address->ElectronicAddress(
1290                 NCIP::ElectronicAddress->new(
1291                     {
1292                         Type=>'Day Phone',
1293                         Data=>$user->day_phone()
1294                     }
1295                 )
1296             );
1297             push @$addresses, $address;
1298         }
1299         if ($user->evening_phone()) {
1300             my $address = NCIP::User::AddressInformation->new({UserAddressRoleType=>'Evening Phone'});
1301             $address->ElectronicAddress(
1302                 NCIP::ElectronicAddress->new(
1303                     {
1304                         Type=>'Evening Phone',
1305                         Data=>$user->evening_phone()
1306                     }
1307                 )
1308             );
1309             push @$addresses, $address;
1310         }
1311         if ($user->other_phone()) {
1312             my $address = NCIP::User::AddressInformation->new({UserAddressRoleType=>'Other Phone'});
1313             $address->ElectronicAddress(
1314                 NCIP::ElectronicAddress->new(
1315                     {
1316                         Type=>'Other Phone',
1317                         Data=>$user->other_phone()
1318                     }
1319                 )
1320             );
1321             push @$addresses, $address;
1322         }
1323
1324         $optionalfields->UserAddressInformation($addresses);
1325     }
1326
1327     # Check for User Privilege.
1328     if (grep {$_ eq 'User Privilege'} @$elements) {
1329         # Get the user's group:
1330         my $pgt = $U->simplereq(
1331             'open-ils.pcrud',
1332             'open-ils.pcrud.retrieve.pgt',
1333             $self->{session}->{authtoken},
1334             $user->profile()
1335         );
1336         if ($pgt) {
1337             my $privilege = NCIP::User::Privilege->new();
1338             $privilege->AgencyId($user->home_ou->shortname());
1339             $privilege->AgencyUserPrivilegeType($pgt->name());
1340             $privilege->ValidToDate(_fix_date($user->expire_date()));
1341             $privilege->ValidFromDate(_fix_date($user->create_date()));
1342
1343             my $status = 'Active';
1344             if (_expired($user)) {
1345                 $status = 'Expired';
1346             } elsif ($U->is_true($user->barred())) {
1347                 $status = 'Barred';
1348             } elsif (!$U->is_true($user->active())) {
1349                 $status = 'Inactive';
1350             }
1351             if ($status) {
1352                 $privilege->UserPrivilegeStatus(
1353                     NCIP::User::PrivilegeStatus->new({
1354                         UserPrivilegeStatusType => $status
1355                     })
1356                 );
1357             }
1358
1359             $optionalfields->UserPrivilege([$privilege]);
1360         }
1361     }
1362
1363     # Check for Block Or Trap.
1364     if (grep {$_ eq 'Block Or Trap'} @$elements) {
1365         my $blocks = [];
1366
1367         # First, let's check if the profile is blocked from ILL.
1368         if (grep {$_->id() == $user->profile()} @{$self->{blocked_profiles}}) {
1369             my $block = NCIP::User::BlockOrTrap->new();
1370             $block->AgencyId($user->home_ou->shortname());
1371             $block->BlockOrTrapType('Block Interlibrary Loan');
1372             push @$blocks, $block;
1373         }
1374
1375         # Next, we loop through the user's standing penalties
1376         # looking for blocks on CIRC, HOLD, and RENEW.
1377         my ($have_circ, $have_renew, $have_hold) = (0,0,0);
1378         foreach my $penalty (@{$user->standing_penalties()}) {
1379             next unless($penalty->standing_penalty->block_list());
1380             my @block_list = split(/\|/, $penalty->standing_penalty->block_list());
1381             my $ou = $U->simplereq(
1382                 'open-ils.pcrud',
1383                 'open-ils.pcrud.retrieve.aou',
1384                 $self->{session}->{authtoken},
1385                 $penalty->org_unit()
1386             );
1387
1388             # Block checkout.
1389             if (!$have_circ && grep {$_ eq 'CIRC'} @block_list) {
1390                 my $bot = NCIP::User::BlockOrTrap->new();
1391                 $bot->AgencyId($ou->shortname());
1392                 $bot->BlockOrTrapType('Block Checkout');
1393                 push @$blocks, $bot;
1394                 $have_circ = 1;
1395             }
1396
1397             # Block holds.
1398             if (!$have_hold && grep {$_ eq 'HOLD' || $_ eq 'FULFILL'} @block_list) {
1399                 my $bot = NCIP::User::BlockOrTrap->new();
1400                 $bot->AgencyId($ou->shortname());
1401                 $bot->BlockOrTrapType('Block Holds');
1402                 push @$blocks, $bot;
1403                 $have_hold = 1;
1404             }
1405
1406             # Block renewals.
1407             if (!$have_renew && grep {$_ eq 'RENEW'} @block_list) {
1408                 my $bot = NCIP::User::BlockOrTrap->new();
1409                 $bot->AgencyId($ou->shortname());
1410                 $bot->BlockOrTrapType('Block Renewals');
1411                 push @$blocks, $bot;
1412                 $have_renew = 1;
1413             }
1414
1415             # Stop after we report one of each, even if more
1416             # blocks remain.
1417             last if ($have_circ && $have_renew && $have_hold);
1418         }
1419
1420         $optionalfields->BlockOrTrap($blocks);
1421     }
1422
1423     return $optionalfields;
1424 }
1425
1426 =head2 handle_item_elements
1427
1428 =cut
1429
1430 sub handle_item_elements {
1431     my $self = shift;
1432     my $copy = shift;
1433     my $elements = shift;
1434     my $optionalfields = NCIP::Item::OptionalFields->new();
1435
1436     my $details; # In case we need for more than one.
1437
1438     if (grep {$_ eq 'Bibliographic Description'} @$elements) {
1439         my $description;
1440         # Check for a precat copy, 'cause it is simple.
1441         if ($copy->dummy_title()) {
1442             $description = NCIP::Item::BibliographicDescription->new();
1443             $description->Title($copy->dummy_title());
1444             $description->Author($copy->dummy_author());
1445             if ($copy->dummy_isbn()) {
1446                 $description->BibliographicItemId(
1447                     NCIP::Item::BibliographicItemId->new(
1448                         {
1449                             BibliographicItemIdentifier => $copy->dummy_isbn(),
1450                             BibliographicItemIdentifierCode => 'ISBN'
1451                         }
1452                     )
1453                 );
1454             }
1455         } else {
1456             $details = $self->retrieve_copy_details_by_barcode($copy->barcode()) unless($details);
1457             $description = NCIP::Item::BibliographicDescription->new();
1458             $description->Title($details->{mvr}->title());
1459             $description->Author($details->{mvr}->author());
1460             $description->BibliographicRecordId(
1461                 NCIP::Item::BibliographicRecordId->new(
1462                     {
1463                         BibliographicRecordIdentifier => $details->{mvr}->doc_id(),
1464                         BibliographicRecordIdentifierCode => 'SYSNUMBER'
1465                     }
1466                 )
1467             );
1468             if ($details->{mvr}->publisher()) {
1469                 $description->Publisher($details->{mvr}->publisher());
1470             }
1471             if ($details->{mvr}->pubdate()) {
1472                 $description->PublicationDate($details->{mvr}->pubdate());
1473             }
1474             if ($details->{mvr}->edition()) {
1475                 $description->Edition($details->{mvr}->edition());
1476             }
1477         }
1478         $optionalfields->BibliographicDescription($description) if ($description);
1479     }
1480
1481     if (grep {$_ eq 'Item Description'} @$elements) {
1482         $details = $self->retrieve_copy_details_by_barcode($copy->barcode()) unless($details);
1483         # Call Number is the only field we currently return. We also
1484         # do not attempt to retun a prefix and suffix. Someone else
1485         # can deal with that if they want it.
1486         if ($details->{volume}) {
1487             $optionalfields->ItemDescription(
1488                 NCIP::Item::Description->new(
1489                     {CallNumber => $details->{volume}->label()}
1490                 )
1491             );
1492         }
1493     }
1494
1495     if (grep {$_ eq 'Circulation Status'} @$elements) {
1496         my $status = $copy->status();
1497         $status = $self->retrieve_copy_status($status) unless (ref($status));
1498         $optionalfields->CirculationStatus($status->name()) if ($status);
1499     }
1500
1501     if (grep {$_ eq 'Date Due'} @$elements) {
1502         $details = $self->retrieve_copy_details_by_barcode($copy->barcode()) unless($details);
1503         if ($details->{circ}) {
1504             if (!$details->{circ}->checkin_time()) {
1505                 $optionalfields->DateDue(_fix_date($details->{circ}->due_date()));
1506             }
1507         }
1508     }
1509
1510     if (grep {$_ eq 'Item Use Restriction Type'} @$elements) {
1511         $optionalfields->ItemUseRestrictionType('None');
1512     }
1513
1514     if (grep {$_ eq 'Physical Condition'} @$elements) {
1515         $optionalfields->PhysicalCondition(
1516             NCIP::Item::PhysicalCondition->new(
1517                 {PhysicalConditionType => 'Unknown'}
1518             )
1519         );
1520     }
1521
1522     return $optionalfields;
1523 }
1524
1525 =head2 login
1526
1527     $ils->login();
1528
1529 Login to Evergreen via OpenSRF. It uses internal state from the
1530 configuration file to login.
1531
1532 =cut
1533
1534 # Login via OpenSRF to Evergreen.
1535 sub login {
1536     my $self = shift;
1537
1538     # Get the authentication seed.
1539     my $seed = $U->simplereq(
1540         'open-ils.auth',
1541         'open-ils.auth.authenticate.init',
1542         $self->{config}->{credentials}->{username}
1543     );
1544
1545     # Actually login.
1546     if ($seed) {
1547         my $response = $U->simplereq(
1548             'open-ils.auth',
1549             'open-ils.auth.authenticate.complete',
1550             {
1551                 username => $self->{config}->{credentials}->{username},
1552                 password => md5_hex(
1553                     $seed . md5_hex($self->{config}->{credentials}->{password})
1554                 ),
1555                 type => 'staff',
1556                 workstation => $self->{config}->{credentials}->{workstation}
1557             }
1558         );
1559         if ($response) {
1560             $self->{session}->{authtoken} = $response->{payload}->{authtoken};
1561             $self->{session}->{authtime} = $response->{payload}->{authtime};
1562
1563             # Set/reset the work_ou and user data in case something changed.
1564
1565             # Retrieve the work_ou as an object.
1566             $self->{session}->{work_ou} = $U->simplereq(
1567                 'open-ils.pcrud',
1568                 'open-ils.pcrud.search.aou',
1569                 $self->{session}->{authtoken},
1570                 {shortname => $self->{config}->{credentials}->{work_ou}}
1571             );
1572
1573             # We need the user information in order to do some things.
1574             $self->{session}->{user} = $U->check_user_session($self->{session}->{authtoken});
1575
1576         }
1577     }
1578 }
1579
1580 =head2 checkauth
1581
1582     $valid = $ils->checkauth();
1583
1584 Returns 1 if the object a 'valid' authtoken, 0 if not.
1585
1586 =cut
1587
1588 sub checkauth {
1589     my $self = shift;
1590
1591     # We use AppUtils to do the heavy lifting.
1592     if (defined($self->{session})) {
1593         if ($U->check_user_session($self->{session}->{authtoken})) {
1594             return 1;
1595         } else {
1596             return 0;
1597         }
1598     }
1599
1600     # If we reach here, we don't have a session, so we are definitely
1601     # not logged in.
1602     return 0;
1603 }
1604
1605 =head2 retrieve_user_by_barcode
1606
1607     $user = $ils->retrieve_user_by_barcode($user_barcode, $user_idfield);
1608
1609 Do a fleshed retrieve of a patron by barcode. Return the patron if
1610 found and valid. Return a NCIP::Problem of 'Unknown User' otherwise.
1611
1612 The id field argument is used for the ProblemElement field in the
1613 NCIP::Problem object.
1614
1615 An invalid patron is one where the barcode is not found in the
1616 database, the patron is deleted, or the barcode used to retrieve the
1617 patron is not active. The problem element is also returned if an error
1618 occurs during the retrieval.
1619
1620 =cut
1621
1622 sub retrieve_user_by_barcode {
1623     my ($self, $barcode, $idfield) = @_;
1624     my $result = $U->simplereq(
1625         'open-ils.actor',
1626         'open-ils.actor.user.fleshed.retrieve_by_barcode',
1627         $self->{session}->{authtoken},
1628         $barcode,
1629         1
1630     );
1631
1632     # Check for a failure, or a deleted, inactive, or expired user,
1633     # and if so, return empty userdata.
1634     if (!$result || $U->event_code($result) || $U->is_true($result->deleted())
1635             || !grep {$_->barcode() eq $barcode && $U->is_true($_->active())} @{$result->cards()}) {
1636
1637         my $problem = NCIP::Problem->new();
1638         $problem->ProblemType('Unknown User');
1639         $problem->ProblemDetail("User with barcode $barcode unknown");
1640         $problem->ProblemElement($idfield);
1641         $problem->ProblemValue($barcode);
1642         $result = $problem;
1643     }
1644
1645     return $result;
1646 }
1647
1648 =head2 retrieve_user_by_id
1649
1650     $user = $ils->retrieve_user_by_id($id);
1651
1652 Similar to C<retrieve_user_by_barcode> but takes the user's database
1653 id rather than barcode. This is useful when you have a circulation or
1654 hold and need to get information about the user's involved in the hold
1655 or circulaiton.
1656
1657 It returns a fleshed user on success or undef on failure.
1658
1659 =cut
1660
1661 sub retrieve_user_by_id {
1662     my ($self, $id) = @_;
1663
1664     # Do a fleshed retrieve of the patron, and flesh the fields that
1665     # we would normally use.
1666     my $result = $U->simplereq(
1667         'open-ils.actor',
1668         'open-ils.actor.user.fleshed.retrieve',
1669         $self->{session}->{authtoken},
1670         $id,
1671         [ 'card', 'cards', 'standing_penalties', 'addresses', 'home_ou' ]
1672     );
1673     # Check for an error.
1674     undef($result) if ($result && $U->event_code($result));
1675
1676     return $result;
1677 }
1678
1679 =head2 check_user_for_problems
1680
1681     $problem = $ils>check_user_for_problems($user, 'HOLD, 'CIRC', 'RENEW');
1682
1683 This function checks if a user has a blocked profile or any from a
1684 list of provided blocks. If it does, then a NCIP::Problem object is
1685 returned, otherwise an undefined value is returned.
1686
1687 The list of blocks appears as additional arguments after the user. You
1688 can provide any value(s) that might appear in a standing penalty block
1689 lit in Evergreen. The example above checks for HOLD, CIRC, and
1690 RENEW. Any number of such values can be provided. If none are
1691 provided, the function only checks if the patron's profiles appears in
1692 the object's blocked profiles list.
1693
1694 It stops on the first matching block, if any.
1695
1696 =cut
1697
1698 sub check_user_for_problems {
1699     my $self = shift;
1700     my $user = shift;
1701     my @blocks = @_;
1702
1703     # Fill this in if we have a problem, otherwise just return it.
1704     my $problem;
1705
1706     # First, check the user's profile.
1707     if (grep {$_->id() == $user->profile()} @{$self->{blocked_profiles}}) {
1708         $problem = NCIP::Problem->new(
1709             {
1710                 ProblemType => 'User Blocked',
1711                 ProblemDetail => 'User blocked from inter-library loan',
1712                 ProblemElement => 'NULL',
1713                 ProblemValue => 'NULL'
1714             }
1715         );
1716     }
1717
1718     # Next, check if the patron has one of the indicated blocks.
1719     unless ($problem) {
1720         foreach my $penalty (@{$user->standing_penalties()}) {
1721             if ($penalty->standing_penalty->block_list()) {
1722                 my @pblocks = split(/\|/, $penalty->standing_penalty->block_list());
1723                 foreach my $block (@blocks) {
1724                     if (grep {$_ =~ /$block/} @pblocks) {
1725                         $problem = NCIP::Problem->new(
1726                             {
1727                                 ProblemType => 'User Blocked',
1728                                 ProblemDetail => 'User blocked from ' .
1729                                     ($block eq 'HOLD') ? 'holds' : (($block eq 'RENEW') ? 'renewals' :
1730                                                                         (($block eq 'CIRC') ? 'checkout' : lc($block))),
1731                                 ProblemElement => 'NULL',
1732                                 ProblemValue => 'NULL'
1733                             }
1734                         );
1735                         last;
1736                     }
1737                 }
1738                 last if ($problem);
1739             }
1740         }
1741     }
1742
1743     return $problem;
1744 }
1745
1746 =head2 check_circ_details
1747
1748     $problem = $ils->check_circ_details($circ, $copy, $user);
1749
1750 Checks if we can checkin or renew a circulation. That is, the
1751 circulation is still open (i.e. the copy is still checked out), if we
1752 either own the copy or are the circulation location, and if the
1753 circulation is for the optional $user argument. $circ and $copy are
1754 required. $user is optional.
1755
1756 Returns a problem if any of the above conditions fail. Returns undef
1757 if they pass and we can proceed with the checkin or renewal.
1758
1759 If the failure occurred on the copy-related checks, then the
1760 ProblemElement field will be undefined and needs to be filled in with
1761 the item id field name. If the check for the copy being checked out to
1762 the provided user fails, then both ProblemElement and ProblemValue
1763 fields will be empty and need to be filled in by the caller.
1764
1765 =cut
1766
1767 sub check_circ_details {
1768     my ($self, $circ, $copy, $user) = @_;
1769
1770     # Shortcut for the next check.
1771     my $ou_id = $self->{session}->{work_ou}->id();
1772
1773     if (!$circ || $circ->checkin_time() || ($circ->circ_lib() != $ou_id && $copy->circ_lib() != $ou_id)) {
1774         # Item isn't checked out.
1775         return NCIP::Problem->new(
1776             {
1777                 ProblemType => 'Item Not Checked Out',
1778                 ProblemDetail => 'Item with barcode ' . $copy->barcode() . ' is not checked out.',
1779                 ProblemValue => $copy->barcode()
1780             }
1781         );
1782     } else {
1783         # Get data on the patron who has it checked out.
1784         my $circ_user = $self->retrieve_user_by_id($circ->usr());
1785         if ($user && $circ_user && $user->id() != $circ_user->id()) {
1786             # The ProblemElement and ProblemValue field need to be
1787             # filled in by the caller.
1788             return NCIP::Problem->new(
1789                 {
1790                     ProblemType => 'Item Not Checked Out To This User',
1791                     ProblemDetail => 'Item with barcode ' . $copy->barcode() . ' is not checked out to this user.',
1792                 }
1793             );
1794         }
1795     }
1796     # If we get here, we're good to go.
1797     return undef;
1798 }
1799
1800 =head2 retrieve_copy_details_by_barcode
1801
1802     $copy = $ils->retrieve_copy_details_by_barcode($copy_barcode);
1803
1804 Look up and retrieve some copy details by the copy barcode. This
1805 method returns either a hashref with the copy details or undefined if
1806 no copy exists with that barcode or if some error occurs.
1807
1808 The hashref has the fields copy, hold, transit, circ, volume, and mvr.
1809
1810 This method differs from C<retrieve_user_by_barcode> in that a copy
1811 cannot be invalid if it exists and it is not always an error if no
1812 copy exists. In some cases, when handling AcceptItem, we might prefer
1813 there to be no copy.
1814
1815 =cut
1816
1817 sub retrieve_copy_details_by_barcode {
1818     my $self = shift;
1819     my $barcode = shift;
1820
1821     my $copy = $U->simplereq(
1822         'open-ils.circ',
1823         'open-ils.circ.copy_details.retrieve.barcode',
1824         $self->{session}->{authtoken},
1825         $barcode
1826     );
1827
1828     # If $copy is an event, return undefined.
1829     if ($copy && $U->event_code($copy)) {
1830         undef($copy);
1831     }
1832
1833     return $copy;
1834 }
1835
1836 =head2 retrieve_copy_details_by_id
1837
1838     $copy = $ils->retrieve_copy_details_by_id($copy_id);
1839
1840 Retrieve copy_details by copy id. Same as the above, but with a copy
1841 id instead of barcode.
1842
1843 =cut
1844
1845 sub retrieve_copy_details_by_id {
1846     my $self = shift;
1847     my $copy_id = shift;
1848
1849     my $copy = $U->simplereq(
1850         'open-ils.circ',
1851         'open-ils.circ.copy_details.retrieve',
1852         $self->{session}->{authtoken},
1853         $copy_id
1854     );
1855
1856     # If $copy is an event, return undefined.
1857     if ($copy && $U->event_code($copy)) {
1858         undef($copy);
1859     }
1860
1861     return $copy;
1862 }
1863
1864 =head2 retrieve_copy_status
1865
1866     $status = $ils->retrieve_copy_status($id);
1867
1868 Retrive a copy status object by database ID.
1869
1870 =cut
1871
1872 sub retrieve_copy_status {
1873     my $self = shift;
1874     my $id = shift;
1875
1876     my $status = $U->simplereq(
1877         'open-ils.pcrud',
1878         'open-ils.pcrud.retrieve.ccs',
1879         $self->{session}->{authtoken},
1880         $id
1881     );
1882
1883     return $status;
1884 }
1885
1886 =head2 retrieve_org_unit_by_shortname
1887
1888     $org_unit = $ils->retrieve_org_unit_by_shortname($shortname);
1889
1890 Retrieves an org. unit from the database by shortname, and fleshes the
1891 ou_type field. Returns the org. unit as a Fieldmapper object or
1892 undefined.
1893
1894 =cut
1895
1896 sub retrieve_org_unit_by_shortname {
1897     my $self = shift;
1898     my $shortname = shift;
1899
1900     my $aou = $U->simplereq(
1901         'open-ils.actor',
1902         'open-ils.actor.org_unit.retrieve_by_shortname',
1903         $shortname
1904     );
1905
1906     # Check for failure from the above.
1907     if (ref($aou) eq 'HASH') {
1908         undef($aou);
1909     }
1910
1911     # We want to retrieve the type and manually "flesh" the object.
1912     if ($aou) {
1913         my $type = $U->simplereq(
1914             'open-ils.pcrud',
1915             'open-ils.pcrud.retrieve.aout',
1916             $self->{session}->{authtoken},
1917             $aou->ou_type()
1918         );
1919         $aou->ou_type($type) if ($type);
1920     }
1921
1922     return $aou;
1923 }
1924
1925 =head2 retrieve_copy_location
1926
1927     $location = $ils->retrieve_copy_location($location_id);
1928
1929 Retrieve a copy location based on id.
1930
1931 =cut
1932
1933 sub retrieve_copy_location {
1934     my $self = shift;
1935     my $id = shift;
1936
1937     my $location = $U->simplereq(
1938         'open-ils.pcrud',
1939         'open-ils.pcrud.retrieve.acpl',
1940         $self->{session}->{authtoken},
1941         $id
1942     );
1943
1944     return $location;
1945 }
1946
1947 =head2 retrieve_biblio_record_entry
1948
1949     $bre = $ils->retrieve_biblio_record_entry($bre_id);
1950
1951 Given a biblio.record_entry.id, this method retrieves a bre object.
1952
1953 =cut
1954
1955 sub retrieve_biblio_record_entry {
1956     my $self = shift;
1957     my $id = shift;
1958
1959     my $bre = $U->simplereq(
1960         'open-ils.pcrud',
1961         'open-ils.pcrud.retrieve.bre',
1962         $self->{session}->{authtoken},
1963         $id
1964     );
1965
1966     return $bre;
1967 }
1968
1969 =head2 create_precat_copy
1970
1971     $item_info->{
1972         barcode => '312340123456789',
1973         author => 'Public, John Q.',
1974         title => 'Magnum Opus',
1975         call_number => '005.82',
1976         publisher => 'Brick House',
1977         publication_date => '2014'
1978     };
1979
1980     $item = $ils->create_precat_copy($item_info);
1981
1982
1983 Create a "precat" copy to use for the incoming item using a hashref of
1984 item information. At a minimum, the barcode, author and title fields
1985 need to be filled in. The other fields are ignored if provided.
1986
1987 This method is called by the AcceptItem handler if the C<use_precats>
1988 configuration option is turned on.
1989
1990 =cut
1991
1992 sub create_precat_copy {
1993     my $self = shift;
1994     my $item_info = shift;
1995
1996     my $item = Fieldmapper::asset::copy->new();
1997     $item->barcode($item_info->{barcode});
1998     $item->call_number(OILS_PRECAT_CALL_NUMBER);
1999     $item->dummy_title($item_info->{title});
2000     $item->dummy_author($item_info->{author});
2001     $item->circ_lib($self->{session}->{work_ou}->id());
2002     $item->circulate('t');
2003     $item->holdable('t');
2004     $item->opac_visible('f');
2005     $item->deleted('f');
2006     $item->fine_level(OILS_PRECAT_COPY_FINE_LEVEL);
2007     $item->loan_duration(OILS_PRECAT_COPY_LOAN_DURATION);
2008     $item->location(1);
2009     $item->status(0);
2010     $item->editor($self->{session}->{user}->id());
2011     $item->creator($self->{session}->{user}->id());
2012     $item->isnew(1);
2013
2014     # Actually create it:
2015     my $xact;
2016     my $ses = OpenSRF::AppSession->create('open-ils.pcrud');
2017     $ses->connect();
2018     eval {
2019         $xact = $ses->request(
2020             'open-ils.pcrud.transaction.begin',
2021             $self->{session}->{authtoken}
2022         )->gather(1);
2023         $item = $ses->request(
2024             'open-ils.pcrud.create.acp',
2025             $self->{session}->{authtoken},
2026             $item
2027         )->gather(1);
2028         $xact = $ses->request(
2029             'open-ils.pcrud.transaction.commit',
2030             $self->{session}->{authtoken}
2031         )->gather(1);
2032     };
2033     if ($@) {
2034         undef($item);
2035         if ($xact) {
2036             eval {
2037                 $ses->request(
2038                     'open-ils.pcrud.transaction.rollback',
2039                     $self->{session}->{authtoken}
2040                 )->gather(1);
2041             };
2042         }
2043     }
2044     $ses->disconnect();
2045
2046     return $item;
2047 }
2048
2049 =head2 create_fuller_copy
2050
2051     $item_info->{
2052         barcode => '31234003456789',
2053         author => 'Public, John Q.',
2054         title => 'Magnum Opus',
2055         call_number => '005.82',
2056         publisher => 'Brick House',
2057         publication_date => '2014'
2058     };
2059
2060     $item = $ils->create_fuller_copy($item_info);
2061
2062 Creates a skeletal bibliographic record, call number, and copy for the
2063 incoming item using a hashref with item information in it. At a
2064 minimum, the barcode, author, title, and call_number fields must be
2065 filled in.
2066
2067 This method is used by the AcceptItem handler if the C<use_precats>
2068 configuration option is NOT set.
2069
2070 =cut
2071
2072 sub create_fuller_copy {
2073     my $self = shift;
2074     my $item_info = shift;
2075
2076     my $item;
2077
2078     # We do everything in one transaction, because it should be atomic.
2079     my $ses = OpenSRF::AppSession->create('open-ils.pcrud');
2080     $ses->connect();
2081     my $xact;
2082     eval {
2083         $xact = $ses->request(
2084             'open-ils.pcrud.transaction.begin',
2085             $self->{session}->{authtoken}
2086         )->gather(1);
2087     };
2088     if ($@) {
2089         undef($xact);
2090     }
2091
2092     # The rest depends on there being a transaction.
2093     if ($xact) {
2094
2095         # Create the MARC record.
2096         my $record = MARC::Record->new();
2097         $record->encoding('UTF-8');
2098         $record->leader('00881nam a2200193   4500');
2099         my $datespec = strftime("%Y%m%d%H%M%S.0", localtime);
2100         my @fields = ();
2101         push(@fields, MARC::Field->new('005', $datespec));
2102         push(@fields, MARC::Field->new('082', '0', '4', 'a' => $item_info->{call_number}));
2103         push(@fields, MARC::Field->new('245', '0', '0', 'a' => $item_info->{title}));
2104         # Publisher is a little trickier:
2105         if ($item_info->{publisher}) {
2106             my $pub = MARC::Field->new('260', ' ', ' ', 'a' => '[S.l.]', 'b' => $item_info->{publisher});
2107             $pub->add_subfields('c' => $item_info->{publication_date}) if ($item_info->{publication_date});
2108             push(@fields, $pub);
2109         }
2110         # We have no idea if the author is personal corporate or something else, so we use a 720.
2111         push(@fields, MARC::Field->new('720', ' ', ' ', 'a' => $item_info->{author}, '4' => 'aut'));
2112         $record->append_fields(@fields);
2113         my $marc = clean_marc($record);
2114
2115         # Create the bib object.
2116         my $bib = Fieldmapper::biblio::record_entry->new();
2117         $bib->creator($self->{session}->{user}->id());
2118         $bib->editor($self->{session}->{user}->id());
2119         $bib->source($self->{bib_source}->id());
2120         $bib->active('t');
2121         $bib->deleted('f');
2122         $bib->marc($marc);
2123         $bib->isnew(1);
2124
2125         eval {
2126             $bib = $ses->request(
2127                 'open-ils.pcrud.create.bre',
2128                 $self->{session}->{authtoken},
2129                 $bib
2130             )->gather(1);
2131         };
2132         if ($@) {
2133             undef($bib);
2134             eval {
2135                 $ses->request(
2136                     'open-ils.pcrud.transaction.rollback',
2137                     $self->{session}->{authtoken}
2138                 )->gather(1);
2139             };
2140         }
2141
2142         # Create the call number
2143         my $acn;
2144         if ($bib) {
2145             $acn = Fieldmapper::asset::call_number->new();
2146             $acn->creator($self->{session}->{user}->id());
2147             $acn->editor($self->{session}->{user}->id());
2148             $acn->label($item_info->{call_number});
2149             $acn->record($bib->id());
2150             $acn->owning_lib($self->{session}->{work_ou}->id());
2151             $acn->deleted('f');
2152             $acn->isnew(1);
2153
2154             eval {
2155                 $acn = $ses->request(
2156                     'open-ils.pcrud.create.acn',
2157                     $self->{session}->{authtoken},
2158                     $acn
2159                 )->gather(1);
2160             };
2161             if ($@) {
2162                 undef($acn);
2163                 eval {
2164                     $ses->request(
2165                         'open-ils.pcrud.transaction.rollback',
2166                         $self->{session}->{authtoken}
2167                     )->gather(1);
2168                 };
2169             }
2170         }
2171
2172         # create the copy
2173         if ($acn) {
2174             $item = Fieldmapper::asset::copy->new();
2175             $item->barcode($item_info->{barcode});
2176             $item->call_number($acn->id());
2177             $item->circ_lib($self->{session}->{work_ou}->id);
2178             $item->circulate('t');
2179             if ($self->{config}->{items}->{use_force_holds}) {
2180                 $item->holdable('f');
2181             } else {
2182                 $item->holdable('t');
2183             }
2184             $item->opac_visible('f');
2185             $item->deleted('f');
2186             $item->fine_level(OILS_PRECAT_COPY_FINE_LEVEL);
2187             $item->loan_duration(OILS_PRECAT_COPY_LOAN_DURATION);
2188             $item->location(1);
2189             $item->status(0);
2190             $item->editor($self->{session}->{user}->id);
2191             $item->creator($self->{session}->{user}->id);
2192             $item->isnew(1);
2193
2194             eval {
2195                 $item = $ses->request(
2196                     'open-ils.pcrud.create.acp',
2197                     $self->{session}->{authtoken},
2198                     $item
2199                 )->gather(1);
2200
2201                 # Cross our fingers and commit the work.
2202                 $xact = $ses->request(
2203                     'open-ils.pcrud.transaction.commit',
2204                     $self->{session}->{authtoken}
2205                 )->gather(1);
2206             };
2207             if ($@) {
2208                 undef($item);
2209                 eval {
2210                     $ses->request(
2211                         'open-ils.pcrud.transaction.rollback',
2212                         $self->{session}->{authtoken}
2213                     )->gather(1) if ($xact);
2214                 };
2215             }
2216         }
2217     }
2218
2219     # We need to disconnect our session.
2220     $ses->disconnect();
2221
2222     # Now, we handle our asset stat_cat entries.
2223     if ($item) {
2224         # It would be nice to do these in the above transaction, but
2225         # pcrud does not support the ascecm object, yet.
2226         foreach my $entry (@{$self->{stat_cat_entries}}) {
2227             my $map = Fieldmapper::asset::stat_cat_entry_copy_map->new();
2228             $map->isnew(1);
2229             $map->stat_cat($entry->stat_cat());
2230             $map->stat_cat_entry($entry->id());
2231             $map->owning_copy($item->id());
2232             # We don't really worry if it succeeds or not.
2233             $U->simplereq(
2234                 'open-ils.circ',
2235                 'open-ils.circ.stat_cat.asset.copy_map.create',
2236                 $self->{session}->{authtoken},
2237                 $map
2238             );
2239         }
2240     }
2241
2242     return $item;
2243 }
2244
2245 =head2 place_hold
2246
2247     $hold = $ils->place_hold($item, $user, $location, $expiration, $org_unit);
2248
2249 This function places a hold on $item for $user for pickup at
2250 $location. If location is not provided or undefined, the user's home
2251 library is used as a fallback.
2252
2253 The $expiration argument is optional and must be a properly formatted
2254 ISO date time. It will be used as the hold expire time, if
2255 provided. Otherwise the system default time will be used.
2256
2257 The $org_unit parameter is only consulted in the event of $item being
2258 a biblio::record_entry object.  In which case, it is expected to be
2259 undefined or an actor::org_unit object.  If it is present, then its id
2260 and ou_type depth (if the ou_type field is fleshed) will be used to
2261 control the selection ou and selection depth for the hold.  This
2262 essentially limits the hold to being filled by copies belonging to the
2263 specified org_unit or its children.
2264
2265 $item can be a copy (asset::copy), volume (asset::call_number), or bib
2266 (biblio::record_entry). The appropriate hold type will be placed
2267 depending on the object.
2268
2269 On success, the method returns the object representing the hold. On
2270 failure, a NCIP::Problem object, describing the failure, is returned.
2271
2272 =cut
2273
2274 sub place_hold {
2275     my $self = shift;
2276     my $item = shift;
2277     my $user = shift;
2278     my $location = shift;
2279     my $expiration = shift;
2280     my $org_unit = shift;
2281
2282     # If $location is undefined, use the user's home_ou, which should
2283     # have been fleshed when the user was retrieved.
2284     $location = $user->home_ou() unless ($location);
2285
2286     # $hold is the hold. $params is for the is_possible check.
2287     my ($hold, $params);
2288
2289     # Prep the hold with fields common to all hold types:
2290     $hold = Fieldmapper::action::hold_request->new();
2291     $hold->isnew(1); # Just to make sure.
2292     $hold->target($item->id());
2293     $hold->usr($user->id());
2294     $hold->pickup_lib($location->id());
2295     $hold->expire_time(cleanse_ISO8601($expiration)) if ($expiration);
2296     if (!$user->email()) {
2297         $hold->email_notify('f');
2298         $hold->phone_notify($user->day_phone()) if ($user->day_phone());
2299     } else {
2300         $hold->email_notify('t');
2301     }
2302
2303     # Ditto the params:
2304     $params = { pickup_lib => $location->id(), patronid => $user->id() };
2305
2306     if (ref($item) eq 'Fieldmapper::asset::copy') {
2307         my $type = ($self->{config}->{items}->{use_force_holds}) ? 'F' : 'C';
2308         $hold->hold_type($type);
2309         $hold->current_copy($item->id());
2310         $params->{hold_type} = $type;
2311         $params->{copy_id} = $item->id();
2312     } elsif (ref($item) eq 'Fieldmapper::asset::call_number') {
2313         $hold->hold_type('V');
2314         $params->{hold_type} = 'V';
2315         $params->{volume_id} = $item->id();
2316     } elsif (ref($item) eq 'Fieldmapper::biblio::record_entry') {
2317         $hold->hold_type('T');
2318         $params->{hold_type} = 'T';
2319         $params->{titleid} = $item->id();
2320         if ($org_unit && ref($org_unit) eq 'Fieldmapper::actor::org_unit') {
2321             $hold->selection_ou($org_unit->id());
2322             $hold->selection_depth($org_unit->ou_type->depth()) if (ref($org_unit->ou_type()));
2323         }
2324     }
2325
2326     # Check for a duplicate hold:
2327     my $duplicate = $U->simplereq(
2328         'open-ils.pcrud',
2329         'open-ils.pcrud.search.ahr',
2330         $self->{session}->{authtoken},
2331         {
2332             hold_type => $hold->hold_type(),
2333             target => $hold->target(),
2334             usr => $hold->usr(),
2335             expire_time => {'>' => 'now'},
2336             cancel_time => undef,
2337             fulfillment_time => undef
2338         }
2339     );
2340     if ($duplicate) {
2341         return NCIP::Problem->new(
2342             {
2343                 ProblemType => 'Duplicate Request',
2344                 ProblemDetail => 'A request for this item already exists for this patron.',
2345                 ProblemElement => 'NULL',
2346                 ProblemValue => 'NULL'
2347             }
2348         );
2349     }
2350
2351     # Check if the hold is possible:
2352     my $r = $U->simplereq(
2353         'open-ils.circ',
2354         'open-ils.circ.title_hold.is_possible',
2355         $self->{session}->{authtoken},
2356         $params
2357     );
2358
2359     if ($r->{success}) {
2360         $hold = $U->simplereq(
2361             'open-ils.circ',
2362             'open-ils.circ.holds.create.override',
2363             $self->{session}->{authtoken},
2364             $hold
2365         );
2366         if (ref($hold)) {
2367             $hold = $hold->[0] if (ref($hold) eq 'ARRAY');
2368             $hold = _problem_from_event('User Ineligible To Request This Item', $hold);
2369         } else {
2370             # open-ils.circ.holds.create.override returns the id on
2371             # success, so we retrieve the full hold object from the
2372             # database to return it.
2373             $hold = $U->simplereq(
2374                 'open-ils.pcrud',
2375                 'open-ils.pcrud.retrieve.ahr',
2376                 $self->{session}->{authtoken},
2377                 $hold
2378             );
2379         }
2380     } elsif ($r->{last_event}) {
2381         $hold = _problem_from_event('User Ineligible To Request This Item', $r->{last_event});
2382     } elsif ($r->{textcode}) {
2383         $hold = _problem_from_event('User Ineligible To Request This Item', $r);
2384     } else {
2385         $hold = _problem_from_event('User Ineligible To Request This Item');
2386     }
2387
2388     return $hold;
2389 }
2390
2391 =head2 cancel_hold
2392
2393     $result = $ils->cancel_hold($hold);
2394
2395 This method cancels the hold argument. It makes no checks on the hold,
2396 so if there are certain conditions that need to be fulfilled before
2397 the hold is canceled, then you must check them before calling this
2398 method.
2399
2400 It returns the result of the backend call to cancel the hold: 1 on
2401 succes or an ILS event on failure.
2402
2403 =cut
2404
2405 sub cancel_hold {
2406     my $self = shift;
2407     my $hold = shift;
2408
2409     my $r = $U->simplereq(
2410         'open-ils.circ',
2411         'open-ils.circ.hold.cancel',
2412         $self->{session}->{authtoken},
2413         $hold->id(),
2414         '5',
2415         'Canceled via NCIPServer'
2416     );
2417
2418     return $r;
2419 }
2420
2421 =head2 delete_copy
2422
2423     $ils->delete_copy($copy);
2424
2425 Deletes the copy, and if it is owned by our work_ou and not a precat,
2426 we also delete the volume and bib on which the copy depends.
2427
2428 =cut
2429
2430 sub delete_copy {
2431     my $self = shift;
2432     my $copy = shift;
2433
2434     # Shortcut for ownership checks below.
2435     my $ou_id = $self->{session}->{work_ou}->id();
2436
2437     # First, make sure the copy is not already deleted and we own it.
2438     return undef if ($U->is_true($copy->deleted()) || $copy->circ_lib() != $ou_id);
2439
2440     # Indicate we want to delete the copy.
2441     $copy->isdeleted(1);
2442
2443     # Delete the copy using a backend call that will delete the copy,
2444     # the call number, and bib when appropriate.
2445     my $result = $U->simplereq(
2446         'open-ils.cat',
2447         'open-ils.cat.asset.copy.fleshed.batch.update.override',
2448         $self->{session}->{authtoken},
2449         [$copy]
2450     );
2451
2452     # We are currently not checking for succes or failure of the
2453     # above. At some point, someone may want to.
2454
2455     return undef;
2456 }
2457
2458 =head2 copy_can_circulate
2459
2460     $can_circulate = $ils->copy_can_circulate($copy);
2461
2462 Check if the copy's location and the copy itself allow
2463 circulation. Return true if they do, and false if they do not.
2464
2465 =cut
2466
2467 sub copy_can_circulate {
2468     my $self = shift;
2469     my $copy = shift;
2470
2471     my $location = $copy->location();
2472     unless (ref($location)) {
2473         $location = $self->retrieve_copy_location($location);
2474     }
2475
2476     return ($U->is_true($copy->circulate()) && $U->is_true($location->circulate()));
2477 }
2478
2479 =head1 OVERRIDDEN PARENT METHODS
2480
2481 =head2 find_user_barcode
2482
2483 We dangerously override our parent's C<find_user_barcode> to return
2484 either the $barcode or a Problem object. In list context the barcode
2485 or problem will be the first argument and the id field, if any, will
2486 be the second. We also add a second, optional, argument to indicate a
2487 default value for the id field in the event of a failure to find
2488 anything at all. (Perl lets us get away with this.)
2489
2490 =cut
2491
2492 sub find_user_barcode {
2493     my $self = shift;
2494     my $request = shift;
2495     my $default = shift;
2496
2497     unless ($default) {
2498         my $message = $self->parse_request_type($request);
2499         if ($message eq 'LookupUser') {
2500             $default = 'AuthenticationInputData';
2501         } else {
2502             $default = 'UserIdentifierValue';
2503         }
2504     }
2505
2506     my ($value, $idfield) = $self->SUPER::find_user_barcode($request);
2507
2508     unless ($value) {
2509         $idfield = $default unless ($idfield);
2510         $value = NCIP::Problem->new();
2511         $value->ProblemType('Needed Data Missing');
2512         $value->ProblemDetail('Cannot find user barcode in message.');
2513         $value->ProblemElement($idfield);
2514         $value->ProblemValue('NULL');
2515     }
2516
2517     return (wantarray) ? ($value, $idfield) : $value;
2518 }
2519
2520 =head2 find_item_barcode
2521
2522 We do pretty much the same thing as with C<find_user_barcode> for
2523 C<find_item_barcode>.
2524
2525 =cut
2526
2527 sub find_item_barcode {
2528     my $self = shift;
2529     my $request = shift;
2530     my $default = shift || 'ItemIdentifierValue';
2531
2532     my ($value, $idfield) = $self->SUPER::find_item_barcode($request);
2533
2534     unless ($value) {
2535         $idfield = $default unless ($idfield);
2536         $value = NCIP::Problem->new();
2537         $value->ProblemType('Needed Data Missing');
2538         $value->ProblemDetail('Cannot find item barcode in message.');
2539         $value->ProblemElement($idfield);
2540         $value->ProblemValue('NULL');
2541     }
2542
2543     return (wantarray) ? ($value, $idfield) : $value;
2544 }
2545
2546 =head2 find_target_details_by_bre
2547
2548     $copy_details = $ils->find_target_details_by_bre($bre, $selection_ou);
2549
2550 Returns copy details hashref for the "first" holdable copy found on a
2551 biblio.record_entry at an optionally given selection organization.  If
2552 no suitable copy is found, this method returns undef.
2553
2554 =cut
2555
2556 sub find_target_details_by_bre {
2557     my $self = shift;
2558     my $bre = shift;
2559     my $selection_ou = shift;
2560
2561     # The copy details that we find:
2562     my $details;
2563
2564     # We're going to search for non-deleted call numbers and flesh
2565     # copies with copy location and copy status.
2566     my $acns = $self->_call_number_search($bre->id(), $selection_ou, 1);
2567     if ($acns && @$acns) {
2568         # Now, we get available copies, sorted by status id.  We
2569         # only need one, so we take the first that comes out.
2570         my @copies;
2571         foreach (@$acns) {
2572             push(@copies, @{$_->copies()});
2573         }
2574         my ($copy) = sort {$a->status->id() <=> $b->status->id()}
2575             grep { $_->deleted() eq 'f' && $_->holdable() eq 't' && $_->circulate() eq 't' &&
2576                        $_->location->holdable() eq 't' && $_->location->circulate() eq 't' &&
2577                            $_->status->holdable() eq 't' && $_->status->copy_active() eq 't' }
2578                 @copies;
2579         if ($copy) {
2580             $details = $self->retrieve_copy_details_by_id($copy->id());
2581         }
2582     }
2583
2584     return $details;
2585 }
2586
2587 =head2 find_location_failover
2588
2589     $location = $ils->find_location_failover($location, $request, $message);
2590
2591 Attempts to retrieve an org_unit by shortname from the passed in
2592 $location.  If that fails, $request and $message are used to lookup
2593 the ToAgencyId/AgencyId field and that is used.  Returns an org_unit
2594 as retrieved by retrieve_org_unit_by_shortname if successful and undef
2595 on failure.
2596
2597 =cut
2598
2599 sub find_location_failover {
2600     my ($self, $location, $request, $message) = @_;
2601     if ($request && !$message) {
2602         $message = $self->parse_request_type($request);
2603     }
2604     my $org_unit;
2605     if ($location) {
2606         # Because Auto-Graphics. (This should be configured somehow.)
2607         $location =~ s/^[^-]+-//;
2608         $org_unit = $self->retrieve_org_unit_by_shortname($location);
2609     }
2610     if ($request && $message && !$org_unit) {
2611         $location = $request->{$message}->{InitiationHeader}->{ToAgencyId}->{AgencyId};
2612         if ($location) {
2613             # Because Auto-Graphics. (This should be configured somehow.)
2614             $location =~ s/^[^-]+-//;
2615             $org_unit = $self->retrieve_org_unit_by_shortname($location);
2616         }
2617     }
2618
2619     return $org_unit;
2620 }
2621
2622 # private subroutines not meant to be used directly by subclasses.
2623 # Most have to do with setup and/or state checking of implementation
2624 # components.
2625
2626 # Find, load, and parse our configuration file:
2627 sub _configure {
2628     my $self = shift;
2629
2630     # Find the configuration file via variables:
2631     my $file = OILS_NCIP_CONFIG_DEFAULT;
2632     $file = $ENV{OILS_NCIP_CONFIG} if ($ENV{OILS_NCIP_CONFIG});
2633
2634     $self->{config} = XMLin($file, NormaliseSpace => 2,
2635                             ForceArray => ['block_profile', 'stat_cat_entry']);
2636 }
2637
2638 # Bootstrap OpenSRF::System and load the IDL.
2639 sub _bootstrap {
2640     my $self = shift;
2641
2642     my $bootstrap_config = $self->{config}->{bootstrap};
2643     OpenSRF::System->bootstrap_client(config_file => $bootstrap_config);
2644
2645     my $idl = OpenSRF::Utils::SettingsClient->new->config_value("IDL");
2646     Fieldmapper->import(IDL => $idl);
2647 }
2648
2649 # Login and then initialize some object data based on the
2650 # configuration.
2651 sub _init {
2652     my $self = shift;
2653
2654     # Login to Evergreen.
2655     $self->login();
2656
2657     # Load the barred groups as pgt objects into a blocked_profiles
2658     # list.
2659     $self->{blocked_profiles} = [];
2660     if (ref($self->{config}->{patrons}) eq 'HASH') {
2661         foreach (@{$self->{config}->{patrons}->{block_profile}}) {
2662             my $pgt;
2663             if (ref $_) {
2664                 $pgt = $U->simplereq(
2665                     'open-ils.pcrud',
2666                     'open-ils.pcrud.retrieve.pgt',
2667                     $self->{session}->{authtoken},
2668                     $_->{grp}
2669                 );
2670             } else {
2671                 $pgt = $U->simplereq(
2672                     'open-ils.pcrud',
2673                     'open-ils.pcrud.search.pgt',
2674                     $self->{session}->{authtoken},
2675                     {
2676                         name => $_}
2677                 );
2678             }
2679             push(@{$self->{blocked_profiles}}, $pgt) if ($pgt);
2680         }
2681     }
2682
2683     # Load the bib source if we're not using precats.
2684     unless ($self->{config}->{items}->{use_precats}) {
2685         # Retrieve the default
2686         $self->{bib_source} = $U->simplereq(
2687             'open-ils.pcrud',
2688             'open-ils.pcrud.retrieve.cbs',
2689             $self->{session}->{authtoken},
2690             BIB_SOURCE_DEFAULT);
2691         my $data = $self->{config}->{items}->{bib_source};
2692         if ($data) {
2693             $data = $data->[0] if (ref($data) eq 'ARRAY');
2694             my $result;
2695             if (ref $data) {
2696                 $result = $U->simplereq(
2697                     'open-ils.pcrud',
2698                     'open-ils.pcrud.retrieve.cbs',
2699                     $self->{session}->{authtoken},
2700                     $data->{cbs}
2701                 );
2702             } else {
2703                 $result = $U->simplereq(
2704                     'open-ils.pcrud',
2705                     'open-ils.pcrud.search.cbs',
2706                     $self->{session}->{authtoken},
2707                     {source => $data}
2708                 );
2709             }
2710             $self->{bib_source} = $result if ($result);
2711         }
2712     }
2713
2714     # Load the required asset.stat_cat_entries:
2715     $self->{stat_cat_entries} = [];
2716     # First, make a regex for our ou and ancestors:
2717     my $ancestors = join("|", @{$U->get_org_ancestors($self->{session}->{work_ou}->id())});
2718     my $re = qr/(?:$ancestors)/;
2719     # Get the uniq stat_cat ids from the configuration:
2720     my @cats = uniq map {$_->{stat_cat}} @{$self->{config}->{items}->{stat_cat_entry}};
2721     # Retrieve all of the fleshed stat_cats and entries for the above.
2722     my $stat_cats = $U->simplereq(
2723         'open-ils.circ',
2724         'open-ils.circ.stat_cat.asset.retrieve.batch',
2725         $self->{session}->{authtoken},
2726         @cats
2727     );
2728     foreach my $entry (@{$self->{config}->{items}->{stat_cat_entry}}) {
2729         # Must have the stat_cat attr and the name, so we must have a
2730         # reference.
2731         next unless(ref $entry);
2732         my ($stat) = grep {$_->id() == $entry->{stat_cat}} @$stat_cats;
2733         push(@{$self->{stat_cat_entries}}, grep {$_->owner() =~ $re && $_->value() eq $entry->{content}} @{$stat->entries()});
2734     }
2735 }
2736
2737 # Search asset.call_number by a bre.id and location object.
2738 sub _call_number_search {
2739     my $self = shift;
2740     my $bibid = shift;
2741     my $location = shift;
2742     my $flesh = shift;
2743
2744     my $search = {record => $bibid, deleted => 'f'};
2745     if ($location) {
2746         $search->{owning_lib} = {
2747             in => {
2748                 select => {
2749                     aou => [{
2750                         column => 'id',
2751                         transform => 'actor.org_unit_descendants',
2752                         result_field => 'id'
2753                     }]
2754                 },
2755                 from => 'aou',
2756                 where => {id => $location->id()}
2757             }
2758         };
2759     }
2760
2761     # If flesh is passed a true value, we flesh copies, copy status,
2762     # and copy location for the call numbers.
2763     if ($flesh) {
2764         $flesh = {
2765             flesh => 2,
2766             flesh_fields => {
2767                 acn => ['copies'],
2768                 acp => ['status', 'location']
2769             }
2770         }
2771     }
2772
2773     my $acns = $U->simplereq(
2774         'open-ils.pcrud',
2775         'open-ils.pcrud.search.acn.atomic',
2776         $self->{session}->{authtoken},
2777         $search,
2778         $flesh
2779     );
2780
2781     return $acns;
2782 }
2783
2784 # Search for holds using the user, idvalue and selection_ou.
2785 sub _hold_search {
2786     my $self = shift;
2787     my $user = shift;
2788     my $target = shift;
2789     my $selection_ou = shift;
2790
2791     my $hold;
2792
2793     # Retrieve all of the user's active holds, and then search them in Perl.
2794     my $holds_list = $U->simplereq(
2795         'open-ils.circ',
2796         'open-ils.circ.holds.retrieve',
2797         $self->{session}->{authtoken},
2798         $user->id(),
2799         0
2800     );
2801
2802     if ($holds_list && @$holds_list) {
2803         my @holds = grep {$_->target == $target && $_->selection_ou == $selection_ou->id()} @{$holds_list};
2804         # There should only be 1, at this point, if there are any.
2805         if (@holds) {
2806             $hold = $holds[0];
2807         }
2808     }
2809
2810     return $hold;
2811 }
2812
2813 # Standalone, "helper" functions.  These do not take an object or
2814 # class reference.
2815
2816 # Check if a user is past their expiration date.
2817 sub _expired {
2818     my $user = shift;
2819     my $expired = 0;
2820
2821     # Users might not expire.  If so, they have no expire_date.
2822     if ($user->expire_date()) {
2823         my $expires = DateTime::Format::ISO8601->parse_datetime(
2824             cleanse_ISO8601($user->expire_date())
2825         )->epoch();
2826         my $now = DateTime->now()->epoch();
2827         $expired = $now > $expires;
2828     }
2829
2830     return $expired;
2831 }
2832
2833 # Creates a NCIP Problem from an event. Takes a string for the problem
2834 # type, the event hashref (or a string to use for the detail), and
2835 # optional arguments for the ProblemElement and ProblemValue fields.
2836 sub _problem_from_event {
2837     my ($type, $evt, $element, $value) = @_;
2838
2839     my $detail;
2840
2841     # Check the event.
2842     if (ref($evt)) {
2843         my ($textcode, $desc);
2844
2845         # Get the textcode, if available. Otherwise, use the ilsevent
2846         # "id," if available.
2847         if ($evt->{textcode}) {
2848             $textcode = $evt->{textcode};
2849         } elsif ($evt->{ilsevent}) {
2850             $textcode = $evt->{ilsevent};
2851         }
2852
2853         # Get the description. We favor translated descriptions over
2854         # the English in ils_events.xml.
2855         if ($evt->{desc}) {
2856             $desc = $evt->{desc};
2857         }
2858
2859         # Check if $type was set. As an "undocumented" feature, you
2860         # can pass undef, and we'll use the textcode from the event.
2861         unless ($type) {
2862             if ($textcode) {
2863                 $type = $textcode;
2864             }
2865         }
2866
2867         # Set the detail from some combination of the above.
2868         if ($desc) {
2869             $detail = $desc;
2870         } elsif ($textcode eq 'PERM_FAILURE') {
2871             if ($evt->{ilsperm}) {
2872                 $detail = "Permission denied: " . $evt->{ilsperm};
2873                 $detail =~ s/\.override$//;
2874             }
2875         } elsif ($textcode) {
2876             $detail = "ILS returned $textcode error.";
2877         } else {
2878             $detail = 'Detail not available.';
2879         }
2880
2881     } else {
2882         $detail = $evt;
2883     }
2884
2885     return NCIP::Problem->new(
2886         {
2887             ProblemType => ($type) ? $type : 'Temporary Processing Failure',
2888             ProblemDetail => ($detail) ? $detail : 'Detail not available.',
2889             ProblemElement => ($element) ? $element : 'NULL',
2890             ProblemValue => ($value) ? $value : 'NULL'
2891         }
2892     );
2893 }
2894
2895 # "Fix" dates for output so they validate against the schema
2896 sub _fix_date {
2897     my $date = shift;
2898     my $out = DateTime::Format::ISO8601->parse_datetime(cleanse_ISO8601($date));
2899     $out->set_time_zone('UTC');
2900     return $out->iso8601();
2901 }
2902
2903 1;