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