lib/NCIP/ILS/Evergreen.pm

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