lib/NCIP/ILS/Evergreen.pm

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