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