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