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