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($details, $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($details, $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     # Because we need to have a user to place a hold, because the user
 912     # is likely to have problems, and because getting the item
 913     # information for the hold is trickier than getting the user
 914     # information, we'll do the user first and short circuit out of
 915     # the function if there is a problem with the user.
 916     my ($user_barcode, $user_idfield) = $self->find_user_barcode($request);
 917     if (ref($user_barcode) eq 'NCIP::Problem') {
 918         $response->problem($user_barcode);
 919         return $response;
 920     }
 921     my $user = $self->retrieve_user_by_barcode($user_barcode, $user_idfield);
 922     if (ref($user) eq 'NCIP::Problem') {
 923         $response->problem($user);
 924         return $response;
 925     }
 926     my $problem = $self->check_user_for_problems($user, 'HOLD');
 927     if ($problem) {
 928         $response->problem($problem);
 929         return $response;
 930     }
 931
 932     # Auto-Graphics send a single BibliographicRecordId to identify
 933     # the "item" to place on hold.
 934     my $bibid;
 935     if ($request->{$message}->{BibliographicId}) {
 936         my $idxml = $request->{$message}->{BibliographicId};
 937         # The standard allows more than 1.  If that hapens, we only
 938         # use the first.
 939         $idxml = $idxml->[0] if (ref($idxml) eq 'ARRAY');
 940         if ($idxml->{BibliographicRecordId}) {
 941             $bibid = NCIP::Item::BibliographicRecordId->new(
 942                 $idxml->{BibliographicRecordId}
 943             );
 944         }
 945     }
 946     unless ($bibid && $bibid->{BibliographicRecordIdentifier}) {
 947         $problem = NCIP::Problem->new(
 948             {
 949                 ProblemType => 'Needed Data Missing',
 950                 ProblemDetail => 'Need BibliographicRecordIdentifier to place request',
 951                 ProblemElement => 'BibliographicRecordIdentifier',
 952                 ProblemValue => 'NULL'
 953             }
 954         );
 955         $response->problem($problem);
 956         return $response;
 957     }
 958
 959     # We need an actual bre.
 960     my $bre = $self->retrieve_biblio_record_entry($bibid->{BibliographicRecordIdentifier});
 961     if (!$bre || $U->is_true($bre->deleted())) {
 962         $problem = NCIP::Problem->new(
 963             {
 964                 ProblemType => 'Unknown Item',
 965                 ProblemDetail => 'Item ' . $bibid->{BibliographicRecordIdentifier} . ' is unknown',
 966                 ProblemElement => 'BibliographicRecordIdentifier',
 967                 ProblemValue => $bibid->{BibliographicRecordIdentifier}
 968             }
 969         );
 970         $response->problem($problem);
 971         return $response;
 972     }
 973
 974     # Auto-Graphics expects us to limit the selection ou for the hold
 975     # to a given library.  We look fo that in the AgencyId of the
 976     # BibliographRecordId or in the ToAgencyId of the main message.
 977     my $selection_ou = $self->find_location_failover($bibid->{AgencyId}, $request, $message);
 978     unless ($selection_ou) {
 979         $problem = NCIP::Problem->new(
 980             {
 981                 ProblemType => 'Unknown Agency',
 982                 ProblemDetail => 'Agency is not known',
 983                 ProblemElement => 'BibliographicRecordIdentifier',
 984                 ProblemValue => $bibid->{AgencyId} || $request->{$message}->{InitiationHeader}->{ToAgencyId}->{AgencyId}
 985             }
 986         );
 987         $response->problem($problem);
 988         return $response;
 989     }
 990
 991     # See if we were given a pickup location.
 992     my $pickup_ou;
 993     if ($request->{$message}->{PickupLocation}) {
 994         my $loc = $request->{$message}->{PickupLocation};
 995         $loc =~ s/^.*://;
 996         $pickup_ou = $self->retrieve_org_unit_by_shortname($loc);
 997     }
 998
 999     # Look for a NeedBeforeDate to set the expiration.
1000     my $expiration = $request->{$message}->{NeedBeforeDate};
1001
1002     # Place the hold:
1003     my $hold = $self->place_hold($bre, $user, $pickup_ou, $expiration, $selection_ou);
1004     if (ref($hold) eq 'NCIP::Problem') {
1005         $response->problem($hold);
1006     } else {
1007         my $data = {
1008             RequestId => NCIP::RequestId->new(
1009                 $request->{$message}->{RequestId}
1010             ),
1011             ItemId => NCIP::Item::Id->new(
1012                 {
1013                     AgencyId => $selection_ou->shortname(),
1014                     ItemIdentifierValue => $bre->id(),
1015                     ItemIdentifierType => 'SYSNUMBER'
1016                 }
1017             ),
1018             UserId => NCIP::User::Id->new(
1019                 {
1020                     UserIdentifierValue => $user->card->barcode(),
1021                     UserIdentifierType => 'Barcode Id'
1022                 }
1023             ),
1024             RequestType => $request->{$message}->{RequestType},
1025             RequestScopeType => $request->{$message}->{RequestScopeType},
1026         };
1027
1028         # Look for UserElements requested and add it to the response:
1029         my $elements = $request->{$message}->{UserElementType};
1030         if ($elements) {
1031             $elements = [$elements] unless (ref $elements eq 'ARRAY');
1032             my $optionalfields = $self->handle_user_elements($user, $elements);
1033             $data->{UserOptionalFields} = $optionalfields;
1034         }
1035         $elements = $request->{$message}->{ItemElementType};
1036         if ($elements && $hold->current_copy()) {
1037             my $copy_details = $self->retrieve_copy_details_by_id($hold->current_copy());
1038             $elements = [$elements] unless (ref($elements) eq 'ARRAY');
1039             my $optionalfields = $self->handle_item_elements($copy_details->{copy}, $elements);
1040             $data->{ItemOptionalFields} = $optionalfields;
1041         }
1042
1043         $response->data($data);
1044     }
1045
1046     return $response;
1047 }
1048
1049 =head2 cancelrequestitem
1050
1051     $response = $ils->cancelrequestitem($request);
1052
1053 Handle the NCIP CancelRequestItem message.
1054
1055 =cut
1056
1057 sub cancelrequestitem {
1058     my $self = shift;
1059     my $request = shift;
1060     # Check our session and login if necessary:
1061     $self->login() unless ($self->checkauth());
1062
1063     # Common stuff:
1064     my $message = $self->parse_request_type($request);
1065     my $response = NCIP::Response->new({type => $message . 'Response'});
1066     $response->header($self->make_header($request));
1067
1068     # UserId is required by the standard, but we might not really need it.
1069     my ($user_barcode, $user_idfield) = $self->find_user_barcode($request);
1070     if (ref($user_barcode) eq 'NCIP::Problem') {
1071         $response->problem($user_barcode);
1072         return $response;
1073     }
1074     my $user = $self->retrieve_user_by_barcode($user_barcode, $user_idfield);
1075     if (ref($user) eq 'NCIP::Problem') {
1076         $response->problem($user);
1077         return $response;
1078     }
1079
1080     # Auto-Graphics has agreed to return the ItemId that we sent them
1081     # in the RequestItemResponse when they attempt CancelRequestItem
1082     # for that same request.  For the sake of time, we're only going
1083     # to support that method of looking up the hold request in
1084     # Evergreen.  We leave it as future enhancement to make this
1085     # "portable" to other vendors.  (Frankly, that's a fool's errand.
1086     # NCIP is one of those "standards" where you neeed a separate
1087     # implementation for every vendor.)
1088     my $item_id = $request->{$message}->{ItemId};
1089     unless ($item_id) {
1090         # We'll throw a problem that we're missing needed information.
1091         my $problem = NCIP::Problem->new();
1092         $problem->ProblemType('Needed Data Missing');
1093         $problem->ProblemDetail('Cannot find ItemId in message.');
1094         $problem->ProblemElement('ItemId');
1095         $problem->ProblemValue('NULL');
1096         $response->problem($problem);
1097         return $response;
1098     }
1099     my $idvalue = $item_id->{ItemIdentifierValue};
1100     my $itemagy = $item_id->{AgencyId};
1101     my $selection_ou = $self->find_location_failover($itemagy, $request, $message);
1102     unless ($selection_ou) {
1103         my $problem = NCIP::Problem->new(
1104             {
1105                 ProblemType => 'Unknown Agency',
1106                 ProblemDetail => 'Agency is not known',
1107                 ProblemElement => 'AgencyId',
1108                 ProblemValue => $item_id->{AgencyId} || $request->{$message}->{InitiationHeader}->{ToAgencyId}->{AgencyId}
1109             }
1110         );
1111         $response->problem($problem);
1112         return $response;
1113     }
1114
1115     # We should support looking up holds by barcode, since we still
1116     # support placing them by barcode, but that is not how it is going
1117     # to work with Auto-Graphics, apparently.  I'll leave the
1118     # reimplementation of that for a future enhancement.
1119
1120     # See if we can find the hold:
1121     my $hold = $self->_hold_search($user, $idvalue, $selection_ou);
1122     if ($hold && $hold->transit()) {
1123         $response->problem(
1124             NCIP::Problem->new(
1125                 {
1126                     ProblemType => 'Request Already Processed',
1127                     ProblemDetail => 'Request has already been processed',
1128                     ProblemElement => 'RequestIdentifierValue',
1129                     ProblemValue => $request->{message}->{RequestId}->{RequestIdentifierValue}
1130                 }
1131             )
1132        );
1133     } elsif ($hold) {
1134         my $result = $self->cancel_hold($hold);
1135         if (ref($result)) {
1136             $response->problem(_problem_from_event("Temporary Processing Failure", $result));
1137         } else {
1138             my $data = {
1139                 RequestId => NCIP::RequestId->new(
1140                     {
1141                         AgencyId => $request->{$message}->{RequestId}->{AgencyId},
1142                         RequestIdentifierType => $request->{$message}->{RequestId}->{RequestIdentifierType},
1143                         RequestIdentifierValue => $request->{$message}->{RequestId}->{RequestIdentifierValue}
1144                     }
1145                 ),
1146                 UserId => NCIP::User::Id->new(
1147                     {
1148                         UserIdentifierType => 'Barcode Id',
1149                         UserIdentifierValue => $user->card->barcode()
1150                     }
1151                 ),
1152                 ItemId => NCIP::Item::Id->new(
1153                     {
1154                         AgencyId => $request->{$message}->{ItemId}->{AgencyId},
1155                         ItemIdentifierType => $request->{$message}->{ItemId}->{ItemIdentifierType},
1156                         ItemIdentifierValue => $request->{$message}->{ItemId}->{ItemIdentifierValue}
1157                     }
1158                 )
1159             };
1160             # Look for UserElements requested and add it to the response:
1161             my $elements = $request->{$message}->{UserElementType};
1162             if ($elements) {
1163                 $elements = [$elements] unless (ref $elements eq 'ARRAY');
1164                 my $optionalfields = $self->handle_user_elements($user, $elements);
1165                 $data->{UserOptionalFields} = $optionalfields;
1166             }
1167             $elements = $request->{$message}->{ItemElementType};
1168             if ($elements && $hold->current_copy()) {
1169                 $elements = [$elements] unless (ref $elements eq 'ARRAY');
1170                 my $copy_details = $self->retrieve_copy_details_by_id($hold->current_copy());
1171                 if ($copy_details) {
1172                     my $optionalfields = $self->handle_item_elements($copy_details->{copy}, $elements);
1173                     $data->{ItemOptionalFields} = $optionalfields;
1174                 }
1175             }
1176             $response->data($data);
1177         }
1178     } else {
1179         $response->problem(
1180             NCIP::Problem->new(
1181                 {
1182                     ProblemType => 'Unknown Request',
1183                     ProblemDetail => 'No request found for the item and user',
1184                     ProblemElement => 'NULL',
1185                     ProblemValue => 'NULL'
1186                 }
1187             )
1188         )
1189     }
1190
1191     return $response;
1192 }
1193
1194 =head1 METHODS USEFUL to SUBCLASSES
1195
1196 =head2 handle_user_elements
1197     $useroptionalfield = $ils->handle_user_elements($user, $elements);
1198
1199 Returns NCIP::User::OptionalFields for the given user and arrayref of
1200 UserElement.
1201
1202 =cut
1203
1204 sub handle_user_elements {
1205     my $self = shift;
1206     my $user = shift;
1207     my $elements = shift;
1208     my $optionalfields = NCIP::User::OptionalFields->new();
1209
1210     # First, we'll look for name information.
1211     if (grep {$_ eq 'Name Information'} @$elements) {
1212         my $name = NCIP::StructuredPersonalUserName->new();
1213         $name->Surname($user->family_name());
1214         $name->GivenName($user->first_given_name());
1215         $name->Prefix($user->prefix());
1216         $name->Suffix($user->suffix());
1217         $optionalfields->NameInformation($name);
1218     }
1219
1220     # Next, check for user address information.
1221     if (grep {$_ eq 'User Address Information'} @$elements) {
1222         my $addresses = [];
1223
1224         # See if the user has any valid, physcial addresses.
1225         foreach my $addr (@{$user->addresses()}) {
1226             next if ($U->is_true($addr->pending()));
1227             my $address = NCIP::User::AddressInformation->new({UserAddressRoleType=>$addr->address_type()});
1228             my $structured = NCIP::StructuredAddress->new();
1229             $structured->Line1($addr->street1());
1230             $structured->Line2($addr->street2());
1231             $structured->Locality($addr->city());
1232             $structured->Region($addr->state());
1233             $structured->PostalCode($addr->post_code());
1234             $structured->Country($addr->country());
1235             $address->PhysicalAddress(
1236                 NCIP::PhysicalAddress->new(
1237                     {
1238                         StructuredAddress => $structured,
1239                         Type => 'Postal Address'
1240                     }
1241                 )
1242             );
1243             push @$addresses, $address;
1244         }
1245
1246         # Right now, we're only sharing email address if the user
1247         # has it.
1248         if ($user->email()) {
1249             my $address = NCIP::User::AddressInformation->new({UserAddressRoleType=>'Email Address'});
1250             $address->ElectronicAddress(
1251                 NCIP::ElectronicAddress->new({
1252                     Type=>'mailto',
1253                     Data=>$user->email()
1254                 })
1255                 );
1256             push @$addresses, $address;
1257         }
1258         # Auto-graphics asked for the phone numbers.
1259         if ($user->day_phone()) {
1260             my $address = NCIP::User::AddressInformation->new({UserAddressRoleType=>'Day Phone'});
1261             $address->ElectronicAddress(
1262                 NCIP::ElectronicAddress->new(
1263                     {
1264                         Type=>'Day Phone',
1265                         Data=>$user->day_phone()
1266                     }
1267                 )
1268             );
1269             push @$addresses, $address;
1270         }
1271         if ($user->evening_phone()) {
1272             my $address = NCIP::User::AddressInformation->new({UserAddressRoleType=>'Evening Phone'});
1273             $address->ElectronicAddress(
1274                 NCIP::ElectronicAddress->new(
1275                     {
1276                         Type=>'Evening Phone',
1277                         Data=>$user->evening_phone()
1278                     }
1279                 )
1280             );
1281             push @$addresses, $address;
1282         }
1283         if ($user->other_phone()) {
1284             my $address = NCIP::User::AddressInformation->new({UserAddressRoleType=>'Other Phone'});
1285             $address->ElectronicAddress(
1286                 NCIP::ElectronicAddress->new(
1287                     {
1288                         Type=>'Other Phone',
1289                         Data=>$user->other_phone()
1290                     }
1291                 )
1292             );
1293             push @$addresses, $address;
1294         }
1295
1296         $optionalfields->UserAddressInformation($addresses);
1297     }
1298
1299     # Check for User Privilege.
1300     if (grep {$_ eq 'User Privilege'} @$elements) {
1301         # Get the user's group:
1302         my $pgt = $U->simplereq(
1303             'open-ils.pcrud',
1304             'open-ils.pcrud.retrieve.pgt',
1305             $self->{session}->{authtoken},
1306             $user->profile()
1307         );
1308         if ($pgt) {
1309             my $privilege = NCIP::User::Privilege->new();
1310             $privilege->AgencyId($user->home_ou->shortname());
1311             $privilege->AgencyUserPrivilegeType($pgt->name());
1312             $privilege->ValidToDate(_fix_date($user->expire_date()));
1313             $privilege->ValidFromDate(_fix_date($user->create_date()));
1314
1315             my $status = 'Active';
1316             if (_expired($user)) {
1317                 $status = 'Expired';
1318             } elsif ($U->is_true($user->barred())) {
1319                 $status = 'Barred';
1320             } elsif (!$U->is_true($user->active())) {
1321                 $status = 'Inactive';
1322             }
1323             if ($status) {
1324                 $privilege->UserPrivilegeStatus(
1325                     NCIP::User::PrivilegeStatus->new({
1326                         UserPrivilegeStatusType => $status
1327                     })
1328                 );
1329             }
1330
1331             $optionalfields->UserPrivilege([$privilege]);
1332         }
1333     }
1334
1335     # Check for Block Or Trap.
1336     if (grep {$_ eq 'Block Or Trap'} @$elements) {
1337         my $blocks = [];
1338
1339         # First, let's check if the profile is blocked from ILL.
1340         if (grep {$_->id() == $user->profile()} @{$self->{blocked_profiles}}) {
1341             my $block = NCIP::User::BlockOrTrap->new();
1342             $block->AgencyId($user->home_ou->shortname());
1343             $block->BlockOrTrapType('Block Interlibrary Loan');
1344             push @$blocks, $block;
1345         }
1346
1347         # Next, we loop through the user's standing penalties
1348         # looking for blocks on CIRC, HOLD, and RENEW.
1349         my ($have_circ, $have_renew, $have_hold) = (0,0,0);
1350         foreach my $penalty (@{$user->standing_penalties()}) {
1351             next unless($penalty->standing_penalty->block_list());
1352             my @block_list = split(/\|/, $penalty->standing_penalty->block_list());
1353             my $ou = $U->simplereq(
1354                 'open-ils.pcrud',
1355                 'open-ils.pcrud.retrieve.aou',
1356                 $self->{session}->{authtoken},
1357                 $penalty->org_unit()
1358             );
1359
1360             # Block checkout.
1361             if (!$have_circ && grep {$_ eq 'CIRC'} @block_list) {
1362                 my $bot = NCIP::User::BlockOrTrap->new();
1363                 $bot->AgencyId($ou->shortname());
1364                 $bot->BlockOrTrapType('Block Checkout');
1365                 push @$blocks, $bot;
1366                 $have_circ = 1;
1367             }
1368
1369             # Block holds.
1370             if (!$have_hold && grep {$_ eq 'HOLD' || $_ eq 'FULFILL'} @block_list) {
1371                 my $bot = NCIP::User::BlockOrTrap->new();
1372                 $bot->AgencyId($ou->shortname());
1373                 $bot->BlockOrTrapType('Block Holds');
1374                 push @$blocks, $bot;
1375                 $have_hold = 1;
1376             }
1377
1378             # Block renewals.
1379             if (!$have_renew && grep {$_ eq 'RENEW'} @block_list) {
1380                 my $bot = NCIP::User::BlockOrTrap->new();
1381                 $bot->AgencyId($ou->shortname());
1382                 $bot->BlockOrTrapType('Block Renewals');
1383                 push @$blocks, $bot;
1384                 $have_renew = 1;
1385             }
1386
1387             # Stop after we report one of each, even if more
1388             # blocks remain.
1389             last if ($have_circ && $have_renew && $have_hold);
1390         }
1391
1392         $optionalfields->BlockOrTrap($blocks);
1393     }
1394
1395     return $optionalfields;
1396 }
1397
1398 =head2 handle_item_elements
1399
1400 =cut
1401
1402 sub handle_item_elements {
1403     my $self = shift;
1404     my $copy = shift;
1405     my $elements = shift;
1406     my $optionalfields = NCIP::Item::OptionalFields->new();
1407
1408     my $details; # In case we need for more than one.
1409
1410     if (grep {$_ eq 'Bibliographic Description'} @$elements) {
1411         my $description;
1412         # Check for a precat copy, 'cause it is simple.
1413         if ($copy->dummy_title()) {
1414             $description = NCIP::Item::BibliographicDescription->new();
1415             $description->Title($copy->dummy_title());
1416             $description->Author($copy->dummy_author());
1417             if ($copy->dummy_isbn()) {
1418                 $description->BibliographicItemId(
1419                     NCIP::Item::BibliographicItemId->new(
1420                         {
1421                             BibliographicItemIdentifier => $copy->dummy_isbn(),
1422                             BibliographicItemIdentifierCode => 'ISBN'
1423                         }
1424                     )
1425                 );
1426             }
1427         } else {
1428             $details = $self->retrieve_copy_details_by_barcode($copy->barcode()) unless($details);
1429             $description = NCIP::Item::BibliographicDescription->new();
1430             $description->Title($details->{mvr}->title());
1431             $description->Author($details->{mvr}->author());
1432             $description->BibliographicRecordId(
1433                 NCIP::Item::BibliographicRecordId->new(
1434                     {
1435                         BibliographicRecordIdentifier => $details->{mvr}->doc_id(),
1436                         BibliographicRecordIdentifierCode => 'SYSNUMBER'
1437                     }
1438                 )
1439             );
1440             if ($details->{mvr}->publisher()) {
1441                 $description->Publisher($details->{mvr}->publisher());
1442             }
1443             if ($details->{mvr}->pubdate()) {
1444                 $description->PublicationDate($details->{mvr}->pubdate());
1445             }
1446             if ($details->{mvr}->edition()) {
1447                 $description->Edition($details->{mvr}->edition());
1448             }
1449         }
1450         $optionalfields->BibliographicDescription($description) if ($description);
1451     }
1452
1453     if (grep {$_ eq 'Item Description'} @$elements) {
1454         $details = $self->retrieve_copy_details_by_barcode($copy->barcode()) unless($details);
1455         # Call Number is the only field we currently return. We also
1456         # do not attempt to retun a prefix and suffix. Someone else
1457         # can deal with that if they want it.
1458         if ($details->{volume}) {
1459             $optionalfields->ItemDescription(
1460                 NCIP::Item::Description->new(
1461                     {CallNumber => $details->{volume}->label()}
1462                 )
1463             );
1464         }
1465     }
1466
1467     if (grep {$_ eq 'Circulation Status'} @$elements) {
1468         my $status = $copy->status();
1469         $status = $self->retrieve_copy_status($status) unless (ref($status));
1470         $optionalfields->CirculationStatus($status->name()) if ($status);
1471     }
1472
1473     if (grep {$_ eq 'Date Due'} @$elements) {
1474         $details = $self->retrieve_copy_details_by_barcode($copy->barcode()) unless($details);
1475         if ($details->{circ}) {
1476             if (!$details->{circ}->checkin_time()) {
1477                 $optionalfields->DateDue(_fix_date($details->{circ}->due_date()));
1478             }
1479         }
1480     }
1481
1482     if (grep {$_ eq 'Item Use Restriction Type'} @$elements) {
1483         $optionalfields->ItemUseRestrictionType('None');
1484     }
1485
1486     if (grep {$_ eq 'Physical Condition'} @$elements) {
1487         $optionalfields->PhysicalCondition(
1488             NCIP::Item::PhysicalCondition->new(
1489                 {PhysicalConditionType => 'Unknown'}
1490             )
1491         );
1492     }
1493
1494     return $optionalfields;
1495 }
1496
1497 =head2 login
1498
1499     $ils->login();
1500
1501 Login to Evergreen via OpenSRF. It uses internal state from the
1502 configuration file to login.
1503
1504 =cut
1505
1506 # Login via OpenSRF to Evergreen.
1507 sub login {
1508     my $self = shift;
1509
1510     # Get the authentication seed.
1511     my $seed = $U->simplereq(
1512         'open-ils.auth',
1513         'open-ils.auth.authenticate.init',
1514         $self->{config}->{credentials}->{username}
1515     );
1516
1517     # Actually login.
1518     if ($seed) {
1519         my $response = $U->simplereq(
1520             'open-ils.auth',
1521             'open-ils.auth.authenticate.complete',
1522             {
1523                 username => $self->{config}->{credentials}->{username},
1524                 password => md5_hex(
1525                     $seed . md5_hex($self->{config}->{credentials}->{password})
1526                 ),
1527                 type => 'staff',
1528                 workstation => $self->{config}->{credentials}->{workstation}
1529             }
1530         );
1531         if ($response) {
1532             $self->{session}->{authtoken} = $response->{payload}->{authtoken};
1533             $self->{session}->{authtime} = $response->{payload}->{authtime};
1534
1535             # Set/reset the work_ou and user data in case something changed.
1536
1537             # Retrieve the work_ou as an object.
1538             $self->{session}->{work_ou} = $U->simplereq(
1539                 'open-ils.pcrud',
1540                 'open-ils.pcrud.search.aou',
1541                 $self->{session}->{authtoken},
1542                 {shortname => $self->{config}->{credentials}->{work_ou}}
1543             );
1544
1545             # We need the user information in order to do some things.
1546             $self->{session}->{user} = $U->check_user_session($self->{session}->{authtoken});
1547
1548         }
1549     }
1550 }
1551
1552 =head2 checkauth
1553
1554     $valid = $ils->checkauth();
1555
1556 Returns 1 if the object a 'valid' authtoken, 0 if not.
1557
1558 =cut
1559
1560 sub checkauth {
1561     my $self = shift;
1562
1563     # We use AppUtils to do the heavy lifting.
1564     if (defined($self->{session})) {
1565         if ($U->check_user_session($self->{session}->{authtoken})) {
1566             return 1;
1567         } else {
1568             return 0;
1569         }
1570     }
1571
1572     # If we reach here, we don't have a session, so we are definitely
1573     # not logged in.
1574     return 0;
1575 }
1576
1577 =head2 retrieve_user_by_barcode
1578
1579     $user = $ils->retrieve_user_by_barcode($user_barcode, $user_idfield);
1580
1581 Do a fleshed retrieve of a patron by barcode. Return the patron if
1582 found and valid. Return a NCIP::Problem of 'Unknown User' otherwise.
1583
1584 The id field argument is used for the ProblemElement field in the
1585 NCIP::Problem object.
1586
1587 An invalid patron is one where the barcode is not found in the
1588 database, the patron is deleted, or the barcode used to retrieve the
1589 patron is not active. The problem element is also returned if an error
1590 occurs during the retrieval.
1591
1592 =cut
1593
1594 sub retrieve_user_by_barcode {
1595     my ($self, $barcode, $idfield) = @_;
1596     my $result = $U->simplereq(
1597         'open-ils.actor',
1598         'open-ils.actor.user.fleshed.retrieve_by_barcode',
1599         $self->{session}->{authtoken},
1600         $barcode,
1601         1
1602     );
1603
1604     # Check for a failure, or a deleted, inactive, or expired user,
1605     # and if so, return empty userdata.
1606     if (!$result || $U->event_code($result) || $U->is_true($result->deleted())
1607             || !grep {$_->barcode() eq $barcode && $U->is_true($_->active())} @{$result->cards()}) {
1608
1609         my $problem = NCIP::Problem->new();
1610         $problem->ProblemType('Unknown User');
1611         $problem->ProblemDetail("User with barcode $barcode unknown");
1612         $problem->ProblemElement($idfield);
1613         $problem->ProblemValue($barcode);
1614         $result = $problem;
1615     }
1616
1617     return $result;
1618 }
1619
1620 =head2 retrieve_user_by_id
1621
1622     $user = $ils->retrieve_user_by_id($id);
1623
1624 Similar to C<retrieve_user_by_barcode> but takes the user's database
1625 id rather than barcode. This is useful when you have a circulation or
1626 hold and need to get information about the user's involved in the hold
1627 or circulaiton.
1628
1629 It returns a fleshed user on success or undef on failure.
1630
1631 =cut
1632
1633 sub retrieve_user_by_id {
1634     my ($self, $id) = @_;
1635
1636     # Do a fleshed retrieve of the patron, and flesh the fields that
1637     # we would normally use.
1638     my $result = $U->simplereq(
1639         'open-ils.actor',
1640         'open-ils.actor.user.fleshed.retrieve',
1641         $self->{session}->{authtoken},
1642         $id,
1643         [ 'card', 'cards', 'standing_penalties', 'addresses', 'home_ou' ]
1644     );
1645     # Check for an error.
1646     undef($result) if ($result && $U->event_code($result));
1647
1648     return $result;
1649 }
1650
1651 =head2 check_user_for_problems
1652
1653     $problem = $ils>check_user_for_problems($user, 'HOLD, 'CIRC', 'RENEW');
1654
1655 This function checks if a user has a blocked profile or any from a
1656 list of provided blocks. If it does, then a NCIP::Problem object is
1657 returned, otherwise an undefined value is returned.
1658
1659 The list of blocks appears as additional arguments after the user. You
1660 can provide any value(s) that might appear in a standing penalty block
1661 lit in Evergreen. The example above checks for HOLD, CIRC, and
1662 RENEW. Any number of such values can be provided. If none are
1663 provided, the function only checks if the patron's profiles appears in
1664 the object's blocked profiles list.
1665
1666 It stops on the first matching block, if any.
1667
1668 =cut
1669
1670 sub check_user_for_problems {
1671     my $self = shift;
1672     my $user = shift;
1673     my @blocks = @_;
1674
1675     # Fill this in if we have a problem, otherwise just return it.
1676     my $problem;
1677
1678     # First, check the user's profile.
1679     if (grep {$_->id() == $user->profile()} @{$self->{blocked_profiles}}) {
1680         $problem = NCIP::Problem->new(
1681             {
1682                 ProblemType => 'User Blocked',
1683                 ProblemDetail => 'User blocked from inter-library loan',
1684                 ProblemElement => 'NULL',
1685                 ProblemValue => 'NULL'
1686             }
1687         );
1688     }
1689
1690     # Next, check if the patron has one of the indicated blocks.
1691     unless ($problem) {
1692         foreach my $penalty (@{$user->standing_penalties()}) {
1693             if ($penalty->standing_penalty->block_list()) {
1694                 my @pblocks = split(/\|/, $penalty->standing_penalty->block_list());
1695                 foreach my $block (@blocks) {
1696                     if (grep {$_ =~ /$block/} @pblocks) {
1697                         $problem = NCIP::Problem->new(
1698                             {
1699                                 ProblemType => 'User Blocked',
1700                                 ProblemDetail => 'User blocked from ' .
1701                                     ($block eq 'HOLD') ? 'holds' : (($block eq 'RENEW') ? 'renewals' :
1702                                                                         (($block eq 'CIRC') ? 'checkout' : lc($block))),
1703                                 ProblemElement => 'NULL',
1704                                 ProblemValue => 'NULL'
1705                             }
1706                         );
1707                         last;
1708                     }
1709                 }
1710                 last if ($problem);
1711             }
1712         }
1713     }
1714
1715     return $problem;
1716 }
1717
1718 =head2 check_circ_details
1719
1720     $problem = $ils->check_circ_details($details, $user);
1721
1722 Checks if we can checkin or renew a circulation. That is, the
1723 circulation is still open (i.e. the copy is still checked out), if we
1724 either own the copy or are the circulation location, and if the
1725 circulation is for the optional $user argument. The $details argument
1726 is required and comes from the retrieve_copy_details call. $user is
1727 optional.
1728
1729 Returns a problem if any of the above conditions fail. Returns undef
1730 if they pass and we can proceed with the checkin or renewal.
1731
1732 If the failure occurred on the copy-related checks, then the
1733 ProblemElement field will be undefined and needs to be filled in with
1734 the item id field name. If the check for the copy being checked out to
1735 the provided user fails, then both ProblemElement and ProblemValue
1736 fields will be empty and need to be filled in by the caller.
1737
1738 =cut
1739
1740 sub check_circ_details {
1741     my ($self, $details, $user) = @_;
1742
1743     my $copy = $details->{copy};
1744     my $circ = $details->{circ};
1745     my $transit = $details->{transit};
1746
1747     # Shortcut for the next check.
1748     my $ou_id = $self->{session}->{work_ou}->id();
1749
1750     # We need to have a circulation.  The copy needs to either have
1751     # been checked out at the NCIP user's working_ou or it needs to be
1752     # owned there.  If the circulation was subsequently checked in,
1753     # then we need an open transit to the NCIP user's working_ou.
1754     if (!$circ || ($circ->circ_lib() != $ou_id && $copy->circ_lib() != $ou_id)
1755             || ($circ->checkin_time() && (!$transit || $transit->dest() != $ou_id))) {
1756         # Item isn't checked out.
1757         return NCIP::Problem->new(
1758             {
1759                 ProblemType => 'Item Not Checked Out',
1760                 ProblemDetail => 'Item with barcode ' . $copy->barcode() . ' is not checked out.',
1761                 ProblemValue => $copy->barcode()
1762             }
1763         );
1764     } else {
1765         # Get data on the patron who has it checked out.
1766         my $circ_user = $self->retrieve_user_by_id($circ->usr());
1767         if ($user && $circ_user && $user->id() != $circ_user->id()) {
1768             # The ProblemElement and ProblemValue field need to be
1769             # filled in by the caller.
1770             return NCIP::Problem->new(
1771                 {
1772                     ProblemType => 'Item Not Checked Out To This User',
1773                     ProblemDetail => 'Item with barcode ' . $copy->barcode() . ' is not checked out to this user.',
1774                 }
1775             );
1776         }
1777     }
1778     # If we get here, we're good to go.
1779     return undef;
1780 }
1781
1782 =head2 retrieve_copy_details_by_barcode
1783
1784     $copy = $ils->retrieve_copy_details_by_barcode($copy_barcode);
1785
1786 Look up and retrieve some copy details by the copy barcode. This
1787 method returns either a hashref with the copy details or undefined if
1788 no copy exists with that barcode or if some error occurs.
1789
1790 The hashref has the fields copy, hold, transit, circ, volume, and mvr.
1791
1792 This method differs from C<retrieve_user_by_barcode> in that a copy
1793 cannot be invalid if it exists and it is not always an error if no
1794 copy exists. In some cases, when handling AcceptItem, we might prefer
1795 there to be no copy.
1796
1797 =cut
1798
1799 sub retrieve_copy_details_by_barcode {
1800     my $self = shift;
1801     my $barcode = shift;
1802
1803     my $copy = $U->simplereq(
1804         'open-ils.circ',
1805         'open-ils.circ.copy_details.retrieve.barcode',
1806         $self->{session}->{authtoken},
1807         $barcode
1808     );
1809
1810     # If $copy is an event, return undefined.
1811     if ($copy && $U->event_code($copy)) {
1812         undef($copy);
1813     }
1814
1815     return $copy;
1816 }
1817
1818 =head2 retrieve_copy_details_by_id
1819
1820     $copy = $ils->retrieve_copy_details_by_id($copy_id);
1821
1822 Retrieve copy_details by copy id. Same as the above, but with a copy
1823 id instead of barcode.
1824
1825 =cut
1826
1827 sub retrieve_copy_details_by_id {
1828     my $self = shift;
1829     my $copy_id = shift;
1830
1831     my $copy = $U->simplereq(
1832         'open-ils.circ',
1833         'open-ils.circ.copy_details.retrieve',
1834         $self->{session}->{authtoken},
1835         $copy_id
1836     );
1837
1838     # If $copy is an event, return undefined.
1839     if ($copy && $U->event_code($copy)) {
1840         undef($copy);
1841     }
1842
1843     return $copy;
1844 }
1845
1846 =head2 retrieve_copy_status
1847
1848     $status = $ils->retrieve_copy_status($id);
1849
1850 Retrive a copy status object by database ID.
1851
1852 =cut
1853
1854 sub retrieve_copy_status {
1855     my $self = shift;
1856     my $id = shift;
1857
1858     my $status = $U->simplereq(
1859         'open-ils.pcrud',
1860         'open-ils.pcrud.retrieve.ccs',
1861         $self->{session}->{authtoken},
1862         $id
1863     );
1864
1865     return $status;
1866 }
1867
1868 =head2 retrieve_org_unit_by_shortname
1869
1870     $org_unit = $ils->retrieve_org_unit_by_shortname($shortname);
1871
1872 Retrieves an org. unit from the database by shortname, and fleshes the
1873 ou_type field. Returns the org. unit as a Fieldmapper object or
1874 undefined.
1875
1876 =cut
1877
1878 sub retrieve_org_unit_by_shortname {
1879     my $self = shift;
1880     my $shortname = shift;
1881
1882     my $aou = $U->simplereq(
1883         'open-ils.actor',
1884         'open-ils.actor.org_unit.retrieve_by_shortname',
1885         $shortname
1886     );
1887
1888     # Check for failure from the above.
1889     if (ref($aou) eq 'HASH') {
1890         undef($aou);
1891     }
1892
1893     # We want to retrieve the type and manually "flesh" the object.
1894     if ($aou) {
1895         my $type = $U->simplereq(
1896             'open-ils.pcrud',
1897             'open-ils.pcrud.retrieve.aout',
1898             $self->{session}->{authtoken},
1899             $aou->ou_type()
1900         );
1901         $aou->ou_type($type) if ($type);
1902     }
1903
1904     return $aou;
1905 }
1906
1907 =head2 retrieve_copy_location
1908
1909     $location = $ils->retrieve_copy_location($location_id);
1910
1911 Retrieve a copy location based on id.
1912
1913 =cut
1914
1915 sub retrieve_copy_location {
1916     my $self = shift;
1917     my $id = shift;
1918
1919     my $location = $U->simplereq(
1920         'open-ils.pcrud',
1921         'open-ils.pcrud.retrieve.acpl',
1922         $self->{session}->{authtoken},
1923         $id
1924     );
1925
1926     return $location;
1927 }
1928
1929 =head2 retrieve_biblio_record_entry
1930
1931     $bre = $ils->retrieve_biblio_record_entry($bre_id);
1932
1933 Given a biblio.record_entry.id, this method retrieves a bre object.
1934
1935 =cut
1936
1937 sub retrieve_biblio_record_entry {
1938     my $self = shift;
1939     my $id = shift;
1940
1941     my $bre = $U->simplereq(
1942         'open-ils.pcrud',
1943         'open-ils.pcrud.retrieve.bre',
1944         $self->{session}->{authtoken},
1945         $id
1946     );
1947
1948     return $bre;
1949 }
1950
1951 =head2 create_precat_copy
1952
1953     $item_info->{
1954         barcode => '312340123456789',
1955         author => 'Public, John Q.',
1956         title => 'Magnum Opus',
1957         call_number => '005.82',
1958         publisher => 'Brick House',
1959         publication_date => '2014'
1960     };
1961
1962     $item = $ils->create_precat_copy($item_info);
1963
1964
1965 Create a "precat" copy to use for the incoming item using a hashref of
1966 item information. At a minimum, the barcode, author and title fields
1967 need to be filled in. The other fields are ignored if provided.
1968
1969 This method is called by the AcceptItem handler if the C<use_precats>
1970 configuration option is turned on.
1971
1972 =cut
1973
1974 sub create_precat_copy {
1975     my $self = shift;
1976     my $item_info = shift;
1977
1978     my $item = Fieldmapper::asset::copy->new();
1979     $item->barcode($item_info->{barcode});
1980     $item->call_number(OILS_PRECAT_CALL_NUMBER);
1981     $item->dummy_title($item_info->{title});
1982     $item->dummy_author($item_info->{author});
1983     $item->circ_lib($self->{session}->{work_ou}->id());
1984     $item->circulate('t');
1985     $item->holdable('t');
1986     $item->opac_visible('f');
1987     $item->deleted('f');
1988     $item->fine_level(OILS_PRECAT_COPY_FINE_LEVEL);
1989     $item->loan_duration(OILS_PRECAT_COPY_LOAN_DURATION);
1990     $item->location(1);
1991     $item->status(0);
1992     $item->editor($self->{session}->{user}->id());
1993     $item->creator($self->{session}->{user}->id());
1994     $item->isnew(1);
1995
1996     # Actually create it:
1997     my $xact;
1998     my $ses = OpenSRF::AppSession->create('open-ils.pcrud');
1999     $ses->connect();
2000     eval {
2001         $xact = $ses->request(
2002             'open-ils.pcrud.transaction.begin',
2003             $self->{session}->{authtoken}
2004         )->gather(1);
2005         $item = $ses->request(
2006             'open-ils.pcrud.create.acp',
2007             $self->{session}->{authtoken},
2008             $item
2009         )->gather(1);
2010         $xact = $ses->request(
2011             'open-ils.pcrud.transaction.commit',
2012             $self->{session}->{authtoken}
2013         )->gather(1);
2014     };
2015     if ($@) {
2016         undef($item);
2017         if ($xact) {
2018             eval {
2019                 $ses->request(
2020                     'open-ils.pcrud.transaction.rollback',
2021                     $self->{session}->{authtoken}
2022                 )->gather(1);
2023             };
2024         }
2025     }
2026     $ses->disconnect();
2027
2028     return $item;
2029 }
2030
2031 =head2 create_fuller_copy
2032
2033     $item_info->{
2034         barcode => '31234003456789',
2035         author => 'Public, John Q.',
2036         title => 'Magnum Opus',
2037         call_number => '005.82',
2038         publisher => 'Brick House',
2039         publication_date => '2014'
2040     };
2041
2042     $item = $ils->create_fuller_copy($item_info);
2043
2044 Creates a skeletal bibliographic record, call number, and copy for the
2045 incoming item using a hashref with item information in it. At a
2046 minimum, the barcode, author, title, and call_number fields must be
2047 filled in.
2048
2049 This method is used by the AcceptItem handler if the C<use_precats>
2050 configuration option is NOT set.
2051
2052 =cut
2053
2054 sub create_fuller_copy {
2055     my $self = shift;
2056     my $item_info = shift;
2057
2058     my $item;
2059
2060     # We do everything in one transaction, because it should be atomic.
2061     my $ses = OpenSRF::AppSession->create('open-ils.pcrud');
2062     $ses->connect();
2063     my $xact;
2064     eval {
2065         $xact = $ses->request(
2066             'open-ils.pcrud.transaction.begin',
2067             $self->{session}->{authtoken}
2068         )->gather(1);
2069     };
2070     if ($@) {
2071         undef($xact);
2072     }
2073
2074     # The rest depends on there being a transaction.
2075     if ($xact) {
2076
2077         # Create the MARC record.
2078         my $record = MARC::Record->new();
2079         $record->encoding('UTF-8');
2080         $record->leader('00881nam a2200193   4500');
2081         my $datespec = strftime("%Y%m%d%H%M%S.0", localtime);
2082         my @fields = ();
2083         push(@fields, MARC::Field->new('005', $datespec));
2084         push(@fields, MARC::Field->new('082', '0', '4', 'a' => $item_info->{call_number}));
2085         push(@fields, MARC::Field->new('245', '0', '0', 'a' => $item_info->{title}));
2086         # Publisher is a little trickier:
2087         if ($item_info->{publisher}) {
2088             my $pub = MARC::Field->new('260', ' ', ' ', 'a' => '[S.l.]', 'b' => $item_info->{publisher});
2089             $pub->add_subfields('c' => $item_info->{publication_date}) if ($item_info->{publication_date});
2090             push(@fields, $pub);
2091         }
2092         # We have no idea if the author is personal corporate or something else, so we use a 720.
2093         push(@fields, MARC::Field->new('720', ' ', ' ', 'a' => $item_info->{author}, '4' => 'aut'));
2094         $record->append_fields(@fields);
2095         my $marc = clean_marc($record);
2096
2097         # Create the bib object.
2098         my $bib = Fieldmapper::biblio::record_entry->new();
2099         $bib->creator($self->{session}->{user}->id());
2100         $bib->editor($self->{session}->{user}->id());
2101         $bib->source($self->{bib_source}->id());
2102         $bib->active('t');
2103         $bib->deleted('f');
2104         $bib->marc($marc);
2105         $bib->isnew(1);
2106
2107         eval {
2108             $bib = $ses->request(
2109                 'open-ils.pcrud.create.bre',
2110                 $self->{session}->{authtoken},
2111                 $bib
2112             )->gather(1);
2113         };
2114         if ($@) {
2115             undef($bib);
2116             eval {
2117                 $ses->request(
2118                     'open-ils.pcrud.transaction.rollback',
2119                     $self->{session}->{authtoken}
2120                 )->gather(1);
2121             };
2122         }
2123
2124         # Create the call number
2125         my $acn;
2126         if ($bib) {
2127             $acn = Fieldmapper::asset::call_number->new();
2128             $acn->creator($self->{session}->{user}->id());
2129             $acn->editor($self->{session}->{user}->id());
2130             $acn->label($item_info->{call_number});
2131             $acn->record($bib->id());
2132             $acn->owning_lib($self->{session}->{work_ou}->id());
2133             $acn->deleted('f');
2134             $acn->isnew(1);
2135
2136             eval {
2137                 $acn = $ses->request(
2138                     'open-ils.pcrud.create.acn',
2139                     $self->{session}->{authtoken},
2140                     $acn
2141                 )->gather(1);
2142             };
2143             if ($@) {
2144                 undef($acn);
2145                 eval {
2146                     $ses->request(
2147                         'open-ils.pcrud.transaction.rollback',
2148                         $self->{session}->{authtoken}
2149                     )->gather(1);
2150                 };
2151             }
2152         }
2153
2154         # create the copy
2155         if ($acn) {
2156             $item = Fieldmapper::asset::copy->new();
2157             $item->barcode($item_info->{barcode});
2158             $item->call_number($acn->id());
2159             $item->circ_lib($self->{session}->{work_ou}->id);
2160             $item->circulate('t');
2161             if ($self->{config}->{items}->{use_force_holds}) {
2162                 $item->holdable('f');
2163             } else {
2164                 $item->holdable('t');
2165             }
2166             $item->opac_visible('f');
2167             $item->deleted('f');
2168             $item->fine_level(OILS_PRECAT_COPY_FINE_LEVEL);
2169             $item->loan_duration(OILS_PRECAT_COPY_LOAN_DURATION);
2170             $item->location(1);
2171             $item->status(0);
2172             $item->editor($self->{session}->{user}->id);
2173             $item->creator($self->{session}->{user}->id);
2174             $item->isnew(1);
2175
2176             eval {
2177                 $item = $ses->request(
2178                     'open-ils.pcrud.create.acp',
2179                     $self->{session}->{authtoken},
2180                     $item
2181                 )->gather(1);
2182
2183                 # Cross our fingers and commit the work.
2184                 $xact = $ses->request(
2185                     'open-ils.pcrud.transaction.commit',
2186                     $self->{session}->{authtoken}
2187                 )->gather(1);
2188             };
2189             if ($@) {
2190                 undef($item);
2191                 eval {
2192                     $ses->request(
2193                         'open-ils.pcrud.transaction.rollback',
2194                         $self->{session}->{authtoken}
2195                     )->gather(1) if ($xact);
2196                 };
2197             }
2198         }
2199     }
2200
2201     # We need to disconnect our session.
2202     $ses->disconnect();
2203
2204     # Now, we handle our asset stat_cat entries.
2205     if ($item) {
2206         # It would be nice to do these in the above transaction, but
2207         # pcrud does not support the ascecm object, yet.
2208         foreach my $entry (@{$self->{stat_cat_entries}}) {
2209             my $map = Fieldmapper::asset::stat_cat_entry_copy_map->new();
2210             $map->isnew(1);
2211             $map->stat_cat($entry->stat_cat());
2212             $map->stat_cat_entry($entry->id());
2213             $map->owning_copy($item->id());
2214             # We don't really worry if it succeeds or not.
2215             $U->simplereq(
2216                 'open-ils.circ',
2217                 'open-ils.circ.stat_cat.asset.copy_map.create',
2218                 $self->{session}->{authtoken},
2219                 $map
2220             );
2221         }
2222     }
2223
2224     return $item;
2225 }
2226
2227 =head2 place_hold
2228
2229     $hold = $ils->place_hold($item, $user, $location, $expiration, $org_unit);
2230
2231 This function places a hold on $item for $user for pickup at
2232 $location. If location is not provided or undefined, the user's home
2233 library is used as a fallback.
2234
2235 The $expiration argument is optional and must be a properly formatted
2236 ISO date time. It will be used as the hold expire time, if
2237 provided. Otherwise the system default time will be used.
2238
2239 The $org_unit parameter is only consulted in the event of $item being
2240 a biblio::record_entry object.  In which case, it is expected to be
2241 undefined or an actor::org_unit object.  If it is present, then its id
2242 and ou_type depth (if the ou_type field is fleshed) will be used to
2243 control the selection ou and selection depth for the hold.  This
2244 essentially limits the hold to being filled by copies belonging to the
2245 specified org_unit or its children.
2246
2247 $item can be a copy (asset::copy), volume (asset::call_number), or bib
2248 (biblio::record_entry). The appropriate hold type will be placed
2249 depending on the object.
2250
2251 On success, the method returns the object representing the hold. On
2252 failure, a NCIP::Problem object, describing the failure, is returned.
2253
2254 =cut
2255
2256 sub place_hold {
2257     my $self = shift;
2258     my $item = shift;
2259     my $user = shift;
2260     my $location = shift;
2261     my $expiration = shift;
2262     my $org_unit = shift;
2263
2264     # If $location is undefined, use the user's home_ou, which should
2265     # have been fleshed when the user was retrieved.
2266     $location = $user->home_ou() unless ($location);
2267
2268     # $params for the hold.
2269     my $params = { pickup_lib => $location->id(), patronid => $user->id() };
2270
2271     if (ref($item) eq 'Fieldmapper::asset::copy') {
2272         my $type = ($self->{config}->{items}->{use_force_holds}) ? 'F' : 'C';
2273         $params->{hold_type} = $type;
2274     } elsif (ref($item) eq 'Fieldmapper::asset::call_number') {
2275         $params->{hold_type} = 'V';
2276     } elsif (ref($item) eq 'Fieldmapper::biblio::record_entry') {
2277         $params->{hold_type} = 'T';
2278         if ($org_unit && ref($org_unit) eq 'Fieldmapper::actor::org_unit') {
2279             $params->{selection_ou} = $org_unit->id();
2280             $params->{depth} = $org_unit->ou_type->depth() if (ref($org_unit->ou_type()));
2281         }
2282     }
2283
2284     my $response = $U->simplereq(
2285         'open-ils.circ',
2286         'open-ils.circ.holds.test_and_create.batch',
2287         $self->{session}->{authtoken},
2288         $params,
2289         [$item->id()]
2290     );
2291
2292     if (ref($response->{result})) {
2293         my $event = (ref($response->{result}) eq 'ARRAY') ? $response->{result}->[0] : $response->{result}->{last_event};
2294         if ($event->{textcode} eq 'HOLD_EXISTS') {
2295             return NCIP::Problem->new(
2296                 {
2297                     ProblemType => 'Duplicate Request',
2298                     ProblemDetail => 'A request for this item already exists for this patron.',
2299                     ProblemElement => 'NULL',
2300                     ProblemValue => 'NULL'
2301                 }
2302             );
2303         }
2304         if ($event->{textcode} eq 'ITEM_NOT_HOLDABLE') {
2305             return NCIP::Problem->new(
2306                 {
2307                     ProblemType => 'User Ineligible To Request This Item',
2308                     ProblemDetail => 'Agency rules prevent the Item from being requested by the User.',
2309                     ProblemElement => 'NULL',
2310                     ProblemValue => 'NULL'
2311                 }
2312             );
2313         }
2314         if ($event->{textcode} eq 'HIGH_LEVEL_HOLD_HAS_NO_COPIES') {
2315             return NCIP::Problem->new(
2316                 {
2317                     ProblemType => 'Unknown Item',
2318                     ProblemDetail => 'Agency does not have an Item to fill this request.',
2319                     ProblemElement => 'NULL',
2320                     ProblemValue => 'NULL'
2321                 }
2322             );
2323         }
2324         return _problem_from_event('User Ineligible To Request This Item', $event);
2325     }
2326
2327     # If we make it here, $response->{result} is a hold id.
2328     my $hold = $U->simplereq(
2329         'open-ils.pcrud',
2330         'open-ils.pcrud.retrieve.ahr',
2331         $self->{session}->{authtoken},
2332         $response->{result}
2333     );
2334     return $hold;
2335 }
2336
2337 =head2 cancel_hold
2338
2339     $result = $ils->cancel_hold($hold);
2340
2341 This method cancels the hold argument. It makes no checks on the hold,
2342 so if there are certain conditions that need to be fulfilled before
2343 the hold is canceled, then you must check them before calling this
2344 method.
2345
2346 It returns the result of the backend call to cancel the hold: 1 on
2347 succes or an ILS event on failure.
2348
2349 =cut
2350
2351 sub cancel_hold {
2352     my $self = shift;
2353     my $hold = shift;
2354
2355     my $r = $U->simplereq(
2356         'open-ils.circ',
2357         'open-ils.circ.hold.cancel',
2358         $self->{session}->{authtoken},
2359         $hold->id(),
2360         '5',
2361         'Canceled via NCIPServer'
2362     );
2363
2364     return $r;
2365 }
2366
2367 =head2 delete_copy
2368
2369     $ils->delete_copy($copy);
2370
2371 Deletes the copy, and if it is owned by our work_ou and not a precat,
2372 we also delete the volume and bib on which the copy depends.
2373
2374 =cut
2375
2376 sub delete_copy {
2377     my $self = shift;
2378     my $copy = shift;
2379
2380     # Shortcut for ownership checks below.
2381     my $ou_id = $self->{session}->{work_ou}->id();
2382
2383     # First, make sure the copy is not already deleted and we own it.
2384     return undef if ($U->is_true($copy->deleted()) || $copy->circ_lib() != $ou_id);
2385
2386     # Indicate we want to delete the copy.
2387     $copy->isdeleted(1);
2388     $copy->deleted('t');
2389
2390     # Delete the copy using a backend call that will delete the copy,
2391     # the call number, and bib when appropriate.
2392     my $result = $U->simplereq(
2393         'open-ils.cat',
2394         'open-ils.cat.asset.copy.fleshed.batch.update.override',
2395         $self->{session}->{authtoken},
2396         [$copy]
2397     );
2398
2399     # We are currently not checking for succes or failure of the
2400     # above. At some point, someone may want to.
2401
2402     return undef;
2403 }
2404
2405 =head2 copy_can_circulate
2406
2407     $can_circulate = $ils->copy_can_circulate($copy);
2408
2409 Check if the copy's location and the copy itself allow
2410 circulation. Return true if they do, and false if they do not.
2411
2412 =cut
2413
2414 sub copy_can_circulate {
2415     my $self = shift;
2416     my $copy = shift;
2417
2418     my $location = $copy->location();
2419     unless (ref($location)) {
2420         $location = $self->retrieve_copy_location($location);
2421     }
2422
2423     return ($U->is_true($copy->circulate()) && $U->is_true($location->circulate()));
2424 }
2425
2426 =head1 OVERRIDDEN PARENT METHODS
2427
2428 =head2 find_user_barcode
2429
2430 We dangerously override our parent's C<find_user_barcode> to return
2431 either the $barcode or a Problem object. In list context the barcode
2432 or problem will be the first argument and the id field, if any, will
2433 be the second. We also add a second, optional, argument to indicate a
2434 default value for the id field in the event of a failure to find
2435 anything at all. (Perl lets us get away with this.)
2436
2437 =cut
2438
2439 sub find_user_barcode {
2440     my $self = shift;
2441     my $request = shift;
2442     my $default = shift;
2443
2444     unless ($default) {
2445         my $message = $self->parse_request_type($request);
2446         if ($message eq 'LookupUser') {
2447             $default = 'AuthenticationInputData';
2448         } else {
2449             $default = 'UserIdentifierValue';
2450         }
2451     }
2452
2453     my ($value, $idfield) = $self->SUPER::find_user_barcode($request);
2454
2455     unless ($value) {
2456         $idfield = $default unless ($idfield);
2457         $value = NCIP::Problem->new();
2458         $value->ProblemType('Needed Data Missing');
2459         $value->ProblemDetail('Cannot find user barcode in message.');
2460         $value->ProblemElement($idfield);
2461         $value->ProblemValue('NULL');
2462     }
2463
2464     return (wantarray) ? ($value, $idfield) : $value;
2465 }
2466
2467 =head2 find_item_barcode
2468
2469 We do pretty much the same thing as with C<find_user_barcode> for
2470 C<find_item_barcode>.
2471
2472 =cut
2473
2474 sub find_item_barcode {
2475     my $self = shift;
2476     my $request = shift;
2477     my $default = shift || 'ItemIdentifierValue';
2478
2479     my ($value, $idfield) = $self->SUPER::find_item_barcode($request);
2480
2481     unless ($value) {
2482         $idfield = $default unless ($idfield);
2483         $value = NCIP::Problem->new();
2484         $value->ProblemType('Needed Data Missing');
2485         $value->ProblemDetail('Cannot find item barcode in message.');
2486         $value->ProblemElement($idfield);
2487         $value->ProblemValue('NULL');
2488     }
2489
2490     return (wantarray) ? ($value, $idfield) : $value;
2491 }
2492
2493 =head2 find_location_failover
2494
2495     $location = $ils->find_location_failover($location, $request, $message);
2496
2497 Attempts to retrieve an org_unit by shortname from the passed in
2498 $location.  If that fails, $request and $message are used to lookup
2499 the ToAgencyId/AgencyId field and that is used.  Returns an org_unit
2500 as retrieved by retrieve_org_unit_by_shortname if successful and undef
2501 on failure.
2502
2503 =cut
2504
2505 sub find_location_failover {
2506     my ($self, $location, $request, $message) = @_;
2507     if ($request && !$message) {
2508         $message = $self->parse_request_type($request);
2509     }
2510     my $org_unit;
2511     if ($location) {
2512         # Because Auto-Graphics. (This should be configured somehow.)
2513         $location =~ s/^[^-]+-//;
2514         $org_unit = $self->retrieve_org_unit_by_shortname($location);
2515     }
2516     if ($request && $message && !$org_unit) {
2517         $location = $request->{$message}->{InitiationHeader}->{ToAgencyId}->{AgencyId};
2518         if ($location) {
2519             # Because Auto-Graphics. (This should be configured somehow.)
2520             $location =~ s/^[^-]+-//;
2521             $org_unit = $self->retrieve_org_unit_by_shortname($location);
2522         }
2523     }
2524
2525     return $org_unit;
2526 }
2527
2528 # private subroutines not meant to be used directly by subclasses.
2529 # Most have to do with setup and/or state checking of implementation
2530 # components.
2531
2532 # Find, load, and parse our configuration file:
2533 sub _configure {
2534     my $self = shift;
2535
2536     # Find the configuration file via variables:
2537     my $file = OILS_NCIP_CONFIG_DEFAULT;
2538     $file = $ENV{OILS_NCIP_CONFIG} if ($ENV{OILS_NCIP_CONFIG});
2539
2540     $self->{config} = XMLin($file, NormaliseSpace => 2,
2541                             ForceArray => ['block_profile', 'stat_cat_entry']);
2542 }
2543
2544 # Bootstrap OpenSRF::System and load the IDL.
2545 sub _bootstrap {
2546     my $self = shift;
2547
2548     my $bootstrap_config = $self->{config}->{bootstrap};
2549     OpenSRF::System->bootstrap_client(config_file => $bootstrap_config);
2550
2551     my $idl = OpenSRF::Utils::SettingsClient->new->config_value("IDL");
2552     Fieldmapper->import(IDL => $idl);
2553 }
2554
2555 # Login and then initialize some object data based on the
2556 # configuration.
2557 sub _init {
2558     my $self = shift;
2559
2560     # Login to Evergreen.
2561     $self->login();
2562
2563     # Load the barred groups as pgt objects into a blocked_profiles
2564     # list.
2565     $self->{blocked_profiles} = [];
2566     if (ref($self->{config}->{patrons}) eq 'HASH') {
2567         foreach (@{$self->{config}->{patrons}->{block_profile}}) {
2568             my $pgt;
2569             if (ref $_) {
2570                 $pgt = $U->simplereq(
2571                     'open-ils.pcrud',
2572                     'open-ils.pcrud.retrieve.pgt',
2573                     $self->{session}->{authtoken},
2574                     $_->{grp}
2575                 );
2576             } else {
2577                 $pgt = $U->simplereq(
2578                     'open-ils.pcrud',
2579                     'open-ils.pcrud.search.pgt',
2580                     $self->{session}->{authtoken},
2581                     {
2582                         name => $_}
2583                 );
2584             }
2585             push(@{$self->{blocked_profiles}}, $pgt) if ($pgt);
2586         }
2587     }
2588
2589     # Load the bib source if we're not using precats.
2590     unless ($self->{config}->{items}->{use_precats}) {
2591         # Retrieve the default
2592         $self->{bib_source} = $U->simplereq(
2593             'open-ils.pcrud',
2594             'open-ils.pcrud.retrieve.cbs',
2595             $self->{session}->{authtoken},
2596             BIB_SOURCE_DEFAULT);
2597         my $data = $self->{config}->{items}->{bib_source};
2598         if ($data) {
2599             $data = $data->[0] if (ref($data) eq 'ARRAY');
2600             my $result;
2601             if (ref $data) {
2602                 $result = $U->simplereq(
2603                     'open-ils.pcrud',
2604                     'open-ils.pcrud.retrieve.cbs',
2605                     $self->{session}->{authtoken},
2606                     $data->{cbs}
2607                 );
2608             } else {
2609                 $result = $U->simplereq(
2610                     'open-ils.pcrud',
2611                     'open-ils.pcrud.search.cbs',
2612                     $self->{session}->{authtoken},
2613                     {source => $data}
2614                 );
2615             }
2616             $self->{bib_source} = $result if ($result);
2617         }
2618     }
2619
2620     # Load the required asset.stat_cat_entries:
2621     $self->{stat_cat_entries} = [];
2622     # First, make a regex for our ou and ancestors:
2623     my $ancestors = join("|", @{$U->get_org_ancestors($self->{session}->{work_ou}->id())});
2624     my $re = qr/(?:$ancestors)/;
2625     # Get the uniq stat_cat ids from the configuration:
2626     my @cats = uniq map {$_->{stat_cat}} @{$self->{config}->{items}->{stat_cat_entry}};
2627     # Retrieve all of the fleshed stat_cats and entries for the above.
2628     my $stat_cats = $U->simplereq(
2629         'open-ils.circ',
2630         'open-ils.circ.stat_cat.asset.retrieve.batch',
2631         $self->{session}->{authtoken},
2632         @cats
2633     );
2634     foreach my $entry (@{$self->{config}->{items}->{stat_cat_entry}}) {
2635         # Must have the stat_cat attr and the name, so we must have a
2636         # reference.
2637         next unless(ref $entry);
2638         my ($stat) = grep {$_->id() == $entry->{stat_cat}} @$stat_cats;
2639         push(@{$self->{stat_cat_entries}}, grep {$_->owner() =~ $re && $_->value() eq $entry->{content}} @{$stat->entries()});
2640     }
2641 }
2642
2643 # Search for holds using the user, idvalue and selection_ou.
2644 sub _hold_search {
2645     my $self = shift;
2646     my $user = shift;
2647     my $target = shift;
2648     my $selection_ou = shift;
2649
2650     my $hold;
2651
2652     # Retrieve all of the user's active holds, and then search them in Perl.
2653     my $holds_list = $U->simplereq(
2654         'open-ils.circ',
2655         'open-ils.circ.holds.retrieve',
2656         $self->{session}->{authtoken},
2657         $user->id(),
2658         0
2659     );
2660
2661     if ($holds_list && @$holds_list) {
2662         my @holds = grep {$_->target == $target && $_->selection_ou == $selection_ou->id()} @{$holds_list};
2663         # There should only be 1, at this point, if there are any.
2664         if (@holds) {
2665             $hold = $holds[0];
2666         }
2667     }
2668
2669     return $hold;
2670 }
2671
2672 # Standalone, "helper" functions.  These do not take an object or
2673 # class reference.
2674
2675 # Check if a user is past their expiration date.
2676 sub _expired {
2677     my $user = shift;
2678     my $expired = 0;
2679
2680     # Users might not expire.  If so, they have no expire_date.
2681     if ($user->expire_date()) {
2682         my $expires = DateTime::Format::ISO8601->parse_datetime(
2683             cleanse_ISO8601($user->expire_date())
2684         )->epoch();
2685         my $now = DateTime->now()->epoch();
2686         $expired = $now > $expires;
2687     }
2688
2689     return $expired;
2690 }
2691
2692 # Creates a NCIP Problem from an event. Takes a string for the problem
2693 # type, the event hashref (or a string to use for the detail), and
2694 # optional arguments for the ProblemElement and ProblemValue fields.
2695 sub _problem_from_event {
2696     my ($type, $evt, $element, $value) = @_;
2697
2698     my $detail;
2699
2700     # Check the event.
2701     if (ref($evt)) {
2702         my ($textcode, $desc);
2703
2704         # Get the textcode, if available. Otherwise, use the ilsevent
2705         # "id," if available.
2706         if ($evt->{textcode}) {
2707             $textcode = $evt->{textcode};
2708         } elsif ($evt->{ilsevent}) {
2709             $textcode = $evt->{ilsevent};
2710         }
2711
2712         # Get the description. We favor translated descriptions over
2713         # the English in ils_events.xml.
2714         if ($evt->{desc}) {
2715             $desc = $evt->{desc};
2716         }
2717
2718         # Check if $type was set. As an "undocumented" feature, you
2719         # can pass undef, and we'll use the textcode from the event.
2720         unless ($type) {
2721             if ($textcode) {
2722                 $type = $textcode;
2723             }
2724         }
2725
2726         # Set the detail from some combination of the above.
2727         if ($desc) {
2728             $detail = $desc;
2729         } elsif ($textcode eq 'PERM_FAILURE') {
2730             if ($evt->{ilsperm}) {
2731                 $detail = "Permission denied: " . $evt->{ilsperm};
2732                 $detail =~ s/\.override$//;
2733             }
2734         } elsif ($textcode) {
2735             $detail = "ILS returned $textcode error.";
2736         } else {
2737             $detail = 'Detail not available.';
2738         }
2739
2740     } else {
2741         $detail = $evt;
2742     }
2743
2744     return NCIP::Problem->new(
2745         {
2746             ProblemType => ($type) ? $type : 'Temporary Processing Failure',
2747             ProblemDetail => ($detail) ? $detail : 'Detail not available.',
2748             ProblemElement => ($element) ? $element : 'NULL',
2749             ProblemValue => ($value) ? $value : 'NULL'
2750         }
2751     );
2752 }
2753
2754 # "Fix" dates for output so they validate against the schema
2755 sub _fix_date {
2756     my $date = shift;
2757     my $out = DateTime::Format::ISO8601->parse_datetime(cleanse_ISO8601($date));
2758     $out->set_time_zone('UTC');
2759     return $out->iso8601();
2760 }
2761
2762 1;