lib/NCIP/ILS/Evergreen.pm

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