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