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