lib/NCIP/ILS/Evergreen.pm

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