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