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