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