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