lib/NCIP/ILS/Evergreen.pm

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