lib/NCIP/ILS/Evergreen.pm

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