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