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