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